Delphi FAQ - 1
Как найти CD-ROM диск
Определение пути, где находится программа
Перевод символа в верхний регистр для русского
алфавита
Перевод символа в верхний регистр для русского
алфавита
Замена подстроки в строке
Добавление строки к файлу
Определение размера файла
Сравнение файлов
Получение информации о диске
Получение даты BIOS в Windows 95
Получение типа процессора
Получение переменных среды
Работает ли Delphi сейчас?
Определение имени пользователя
Как найти CD-ROM диск
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;
К оглавлению
|
