{bit utils}
procedure SetBit(var Data:longint;nPos:integer);{установка бита=1 по номеру}
var
 Mask:longint;
begin
 Mask:=1;
 Mask:=Mask shl nPos;
 Data:=Data or Mask;
end;

procedure ResetBit(var Data:longint;nPos:integer);{установка бита=0 по номеру}
var
 Mask:longint;
begin
 Mask:=1;
 Mask:=Mask shl nPos;
 Mask:=not Mask;
 Data:=Data and Mask;
end;

procedure InvertBit(var Data:longint;nPos:integer);{инверсия бита по номеру}
var
 Mask:longint;
begin
 Mask:=1;
 Mask:=Mask shl nPos;
 Data:=Data xor Mask;
end;

procedure PutBit(var Data:longint;nPos:integer;Value:boolean);{установка бита=Value по номеру}
var
 Mask:longint;
begin
 Mask:=1;
 Mask:=Mask shl nPos;
 if Value=true then Data:=Data or Mask
 else begin
  Mask:=not Mask;
  Data:=Data and Mask;
 end;
end;

function TestBit(const Data:longint;nPos:integer):boolean;{проверка значения бита}
var
 Mask:longint;
begin
 Mask:=1;
 Mask:=Mask shl nPos;
 if (Mask and Data)=Mask then Result:=true else Result:=false;
end;

procedure ResetBits(var Data:longint;Mask:longint);{установка битов=0}
begin
 Mask:=not Mask;
 Data:=Data and Mask;
end;

procedure PutBits(var Data:longint;Mask:longint;Value:boolean);{установка битов=Value}
begin
 if Value=true then Data:=Data or Mask
 else begin
  Mask:=not Mask;
  Data:=Data and Mask;
 end;
end;

function TestBits(const Data:longint;Mask:longint):boolean;{Result:=((Mask and Data)=Mask);}
begin
 Result:=((Mask and Data)=Mask);
// if (Mask and Data)=Mask then Result:=true else Result:=false;
end;

function GetFirstCDROM:string;
 {возвращает букву 1-го привода CD-ROM или пустую строку}
var
 w:dword;
 Root:string;
 i:integer;
begin
 w:=GetLogicalDrives;
 Root:='#:\';
 for i:=0 to 25 do begin
  Root[1] := Char(Ord('A')+i);
  if (W and (1 shl i))>0
  then if GetDriveType(Pchar(Root)) = DRIVE_CDROM then begin
   Result:=Root[1];
   exit;
  end;
 end;
 Result:='';
end;

function GetExePath:string;
begin
 Result:=ExtractFilePath(paramstr(0));
end;

function UpCaseRus( ch : Char ) : Char;
asm
        CMP     AL,'a'
        JB      @@exit
        CMP     AL,'z'
        JA      @@Rus
        SUB     AL,'a' - 'A'
        RET
@@Rus:
        CMP     AL,'я'
        JA      @@Exit
        CMP     AL,'а'
        JB      @@yo
        SUB     AL,'я' - 'Я'
        RET
@@yo:
        CMP     AL,'ё'
        JNE      @@exit
        MOV     AL,'Ё'
@@exit:
end;

function LoCaseRus( ch : Char ) : Char;
{Перевод символа в нижний регистр для русского алфавита}
asm
        CMP     AL,'A'
        JB      @@exit
        CMP     AL,'Z'
        JA      @@Rus
        ADD     AL,'a' - 'A'
        RET
@@Rus:
        CMP     AL,'Я'
        JA      @@Exit
        CMP     AL,'А'
        JB      @@yo
        ADD     AL,'я' - 'Я'
        RET
@@yo:
        CMP     AL,'Ё'
        JNE      @@exit
        MOV     AL,'ё'
@@exit:
end;

function ReplaceStr(const S, Srch, Replace: string): string;
{замена подстроки в строке}
var
 I:Integer;
 Source:string;
begin
 Source:= S;
 Result:= '';
 repeat
  I:=Pos(Srch, Source);
  if I > 0 then begin
   Result:=Result+Copy(Source,1,I-1)+Replace;
   Source:=Copy(Source,I+Length(Srch),MaxInt);
  end else Result:=Result+Source;
 until I<=0;
end;

procedure AddStrToFile(S:string;const FileName:string;doNextLine:boolean);
{Добавление строки к файлу
doNextLine - перевод строки}
const
 CR=#13#10;
var
 f:TFileStream;
begin
 if FileExists(FileName)
 then f:=TFileStream.Create(FileName,fmOpenWrite+fmShareDenyNone)
 else f:=TFileStream.Create(FileName,fmCreate);
 f.Position:=f.Size;
 if doNextLine and (f.Size>0)
 then f.Write(CR,2);
 f.Write(pointer(s)^,length(s));
 f.Destroy;
end;

function GetFileSize(const FileName:string):longint;
{Определение размера файла}
var
 SearchRec:TSearchRec;
begin
 if FindFirst(ExpandFileName(FileName),faAnyFile,SearchRec)=0
 then Result:=SearchRec.Size
 else Result:=-1;
 FindClose(SearchRec);
end;

function CompareFiles(Filename1,FileName2:string):longint;
{Сравнение файлов
возвращает номер несовпадающего байта,
(байты отсчитываются с 1)или:
0 - не найдено отличий,
-1 - ошибка файла 1
-2 - ошибка файла 2
-3 - другие ошибки}
const
 Buf_Size=16384;
var
 F1,F2:TFileStream;
 i:longint;
 Buff1,Buff2:PByteArray;
 BytesRead1,BytesRead2:integer;
begin
 Result:=0;
 try
  F1:=TFileStream.Create(FileName1,fmShareDenyNone);
 except
  Result:=-1;
  exit;
 end;
 try
  F2:=TFileStream.Create(FileName2,fmShareDenyNone);
 except
  Result:=-2;
  F1.Free;
  exit;
 end;
 GetMem(Buff1,Buf_Size);
 GetMem(Buff2,Buf_Size);
 try
  if F1.Size>F2.Size then Result:=F2.Size+1
  else if F1.SizeF1.Position) and (Result=0) do begin
    BytesRead1 :=F1.Read(Buff1^,Buf_Size);
    BytesRead2 :=F2.Read(Buff2^,Buf_Size);
    if (BytesRead1=BytesRead2) then begin
     for i:= 0 to BytesRead1-1 do begin
      if Buff1^[i]<>Buff2^[i]
      then begin
       result:=F1.Position-BytesRead1+i+1;
       break;
      end;
     end;
    end else begin
     Result:=-3;
     break;
    end;
   end;
  end;
 except
  Result:=-3;
 end;
 F1.Free;
 F2.Free;
 FreeMem(Buff1,Buf_Size);
 FreeMem(Buff2,Buf_Size);
end;

function GetVolumeInfoFVS(const Dir:string;
 var FileSystemName,VolumeName:string;var Serial:longint):boolean;
{Получение информации о диске
Dir - каталог или буква требуемого диска
FileSystemName - название файловой системы
VolumeName - метка диска
Serial - серийный номер диска
В случае ошибки функция возвращает false}
var
 root:pchar;
 res:longbool;
 VolumeNameBuffer,FileSystemNameBuffer:pchar;
 VolumeNameSize,FileSystemNameSize:DWord;
 VolumeSerialNumber,MaximumComponentLength,FileSystemFlags:DWORD;
 s:string;
 n:integer;
begin
 n:=pos(':',Dir);
 if n>0 then s:=copy(Dir,1,n+1) else s:=s+':';
 if s[length(s)]=':' then s:=s+'\';
 root:=pchar(s);
 getMem(VolumeNameBuffer,256);
 getMem(FileSystemNameBuffer,256);
 VolumeNameSize:=255;
 FileSystemNameSize:=255;
 res:=GetVolumeInformation(Root,VolumeNameBuffer,VolumeNameSize
 ,@VolumeSerialNumber,
 MaximumComponentLength, FileSystemFlags
 ,FileSystemNameBuffer,FileSystemNameSize);
 Result:=res;
 VolumeName:=VolumeNameBuffer;
 FileSystemName:=FileSystemNameBuffer;
 Serial:=VolumeSerialNumber;
 freeMem(VolumeNameBuffer,256);
 freeMem(FileSystemNameBuffer,256);
end;

function GetBIOSDate:string;
{получение даты BIOS в Win95}
var
 s:array[0..7] of char;
 p:pchar;
begin
 p:=@s;
 asm
  push esi
  push edi
  push ecx
  mov esi,$0ffff5
  mov edi,p
  mov cx,8
@@1:mov al,[esi]
  mov [edi],al
  inc edi
  inc esi
  loop @@1
  pop ecx
  pop edi
  pop esi
 end;
 setstring(result,s,8);
end;

function GetProcessorType:integer;
{Определение типа процессора.
Функция возвращает следующие значения,
определенные в модуле Windows:
PROCESSOR_INTEL_386
PROCESSOR_INTEL_486
PROCESSOR_INTEL_PENTIUM
PROCESSOR_MIPS_R4000 - Windows NT only
PROCESSOR_ALPHA_21064 - Windows NT only}
var
 sysInfo:TSystemInfo;
begin
 GetSystemInfo(sysInfo);
 Result:=sysInfo.dwProcessorType;
end;

procedure GetEnvironmentStrings(ss:TStrings);
{Переменные среды}
var
 ptr: PChar;
 s: string;
 Done: boolean;
begin
 ss.Clear;
 s:='';
 Done:=FALSE;
 ptr:=windows.GetEnvironmentStrings;
 while Done=false do begin
  if ptr^=#0 then begin
   inc(ptr);
   if ptr^=#0 then Done:=TRUE
   else ss.Add(s);
   s:=ptr^;
  end else s:=s+ptr^;
  inc(ptr);
 end;
end;

function IsDelphiRun:boolean;
{Работает ли Delphi сейчас}
var
 h1,h2,h3:Hwnd;
begin
 h1:=FindWindow('TAppBuilder',nil);
 h2:=FindWindow('TAlignPalette',nil);
 h3:=FindWindow('TPropertyInspector',nil);
 Result:=(h1<>0)and(h2<>0)and(h3<>0);
end;

function GetUserName:string;
{Определение имени пользователя}
var
 Buffer: array[0..MAX_PATH] of Char;
 sz:DWord;
begin
 sz:=MAX_PATH-1;
 if windows.GetUserName(Buffer,sz)
 then begin
  if sz>0 then dec(sz);
  SetString(Result,Buffer,sz);
 end else begin
  Result:='Error '+inttostr(GetLastError);
 end;
end;

Используются технологии uCoz