www.pudn.com > DriveRescuev1.8.zip > helpers.pas
unit helpers;
interface
uses windows, commctrl;
function Byte2Hex(value: byte): shortstring;
function Word2Hex(value: Word): shortstring;
function Byte2Bin(v : byte) : shortstring;
function Word2Bin(v : word) : shortstring;
function Bin2Word(s: shortstring): word;
function Data2Hex(p: pchar; len: integer): shortstring;
procedure Hex2Data(s: shortstring; p: pchar);
function IsDataEqual(buf: pointer; s: shortstring): boolean;
function BytesEqual(buf1, buf2: pointer; size: longword): longword;
function GetNextTextLine(var buf: pointer; maxbufpos: pointer): shortstring;
function Unicode2ASCII(buf: pointer; len: byte): shortstring;
function replace(s: string; old, new: char): string;
function ConvertFmtString(str: string): string;
function AbbreviatePath(pathname: string; maxchars: integer): string;
function fsTimeDate2Str(time, date: word): shortstring;
function LongWordToStr(number: longword): shortstring;
function MatchWildCard(text, pattern: string; OneCharMatch, AllCharMatch: char;
CaseSensitive: boolean): boolean;
function IsWinNT: boolean;
{: Get the handle of the system's image list.}
function ShellGetSystemImageList(Large: boolean): HImageList;
function ShellGetIconIndex(const APath: string; Attrs: DWORD): integer;
function ShellGetFileInfo(const APath: string; Attrs: DWORD; var Descr: string): integer;
function ShellGetFileType(const APath: string; Attrs: DWORD; var Descr: string): boolean;
function NewDiskFree(rootpath: string): longword;
function ExtractFileNameFaster(pathAndFile: string): string;
function GetRootPath(drivepathname: string): string;
implementation
uses sysutils, shellapi;
// interpretiert \n für RETURN und ersetzt dies durch #13
// kann noch weiter ausgebaut werden
function ConvertFmtString(str: string): string;
var
i: integer;
begin
i:=1;
result:='';
while i <= length(str) do
begin
if str[i] = '\' then
begin
inc(i);
case str[i] of
'\': result:=result + '\';
'n': result:=result + #13;
end;
end else result:=result+str[i];
inc(i);
end;
end;
function fsTimeDate2Str(time, date: word): shortstring;
var
p: array[0..32] of char;
t: array[0..4] of uint;
begin
t[0]:=date AND 31;
t[1]:=(date SHR 5) AND 15;
t[2]:=((date SHR 9) AND 127)+1980;
t[3]:=(time SHR 11) AND 31;
t[4]:=(time SHR 5) AND 63;
wvsprintf(@p, '%02u.%02u.%02u %02u:%02u', @t);
fsTimeDate2Str:=StrPas(p);
end;
function Unicode2ASCII(buf: pointer; len: byte): shortstring;
var
i: byte;
res: shortstring;
w: ^word;
begin
w:=buf;
res:=''; i:=0;
while (w^ <> 0) AND (i < len)do
begin
res:=res + chr(w^ AND 255);
inc(longword(w),2);
inc(i);
end;
Unicode2ASCII:=res;
end;
{ Matches wild card 'pattern' with 'text'
OneCharMatch is the character for single character matching
AllCharMatch is the character for all characters matching }
function MatchWildCard(text, pattern: string; OneCharMatch, AllCharMatch: char;
CaseSensitive: boolean): boolean;
var
i, tpos, ppos: integer;
subpattern: string;
begin
result:=false;
tpos:=1;
for ppos:=1 to length(pattern) do
begin
if pattern[ppos] = AllCharMatch then
begin
// pattern character matches all characters, so get the rest of pattern...
subpattern:=copy(pattern, ppos+1, length(pattern)-ppos);
if subpattern = '' then
begin
// if there is no rest, so pattern matches...
result:=true;
exit;
end;
// ...else check for each subtext if it machtes the rest of the pattern
for i:=tpos to length(text) do
begin
result:=MatchWildCard(copy(text, i, length(text)-i+1), subpattern,
OneCharMatch, AllCharMatch, CaseSensitive);
if result then exit;
end;
exit;
end else if tpos > length(text) then
begin
// no more characters in text to match with => match failed
result:=false;
exit;
end else if (CaseSensitive AND (pattern[ppos] = text[tpos]))
OR (pattern[ppos] = OneCharMatch)
OR (NOT CaseSensitive AND (upcase(pattern[ppos]) = upcase(text[tpos]))) then
begin
inc(tpos); // character matches => increase text position
end else begin
result:=false;
exit;
end;
end;
// all characters matches the pattern if there are no more pattern characters to compare with
result := (tpos = length(text) + 1);
end;
// converts cardinal (32 bit, unsigned) number to string
function LongWordToStr(number: longword): shortstring;
var
restnumber: longword;
i: byte;
begin
restnumber:=number div 10;
if restnumber > 0 then result:=LongWordToStr(restnumber) + chr(48+(number mod 10))
else result:=chr(48+(number mod 10));
end;
function Byte2Hex(value: byte): shortstring;
const
HexCode: array[0..15] of char='0123456789ABCDEF';
var
h: string[2];
begin
h:=' ';
h[1]:=HexCode[value SHR 4];
h[2]:=HexCode[value AND 15];
Byte2Hex:=h;
end;
function Word2Hex(value: Word): shortstring;
begin
Word2Hex := Byte2Hex(hi(value)) + Byte2Hex(lo(value));
end;
function Word2Bin(v : word) : shortstring;
var
i : byte;
s : shortstring;
begin
s:='';
for i:=1 to 16 do
if (v shl (i-1)) and 32768=32768 then s:=s+'1' else s:=s+'0';
Word2Bin:=s;
end;
function Bin2Word(s: shortstring): word;
var
i: integer;
value: word;
begin
result:=0; value:=1;
i:=0;
while (i < 16) AND (i < length(s)) do
begin
if s[i+1] = '1' then result := result + value;
value:=value*2;
inc(i);
end;
end;
function Byte2Bin(v : byte) : shortstring;
var
i : byte;
s : shortstring;
begin
s:='';
for i:=1 to 8 do
if (v shl (i-1)) and 128=128 then s:=s+'1' else s:=s+'0';
Byte2Bin:=s;
end;
function DecVal(ch : char) : byte;
begin
decval:=0;
if ((ch>='0') and (ch<='9')) then decval := ord(ch)-ord('0');
if ((ch>='A') and (ch<='F')) then decval := ord(ch)-ord('A')+$0A;
if ((ch>='a') and (ch<='f')) then decval := ord(ch)-ord('a')+$0A;
end;
function Hex2Dec(s: shortstring): word;
var
i : byte;
tmp : word;
place : word;
error : boolean;
begin
i := ord(s[0]);
error := false;
place := 1;
tmp := 0;
while (i>0) and not(error) do begin
error := not(((s[i]>='0')and(s[i]<='9'))
or ((s[i]>='a')and(s[i]<='f'))
or ((s[i]>='A')and(s[i]<='F')));
tmp := tmp+place*decval(s[i]);
i:=i-1;
place := place*$10;
end;
if (error) then hex2dec := $00
else
hex2dec := tmp;
end;
{ Konvertiert beliebige Daten in Hexadezimal-String
p: Zeiger auf Daten, len: Länge, result = string }
function Data2Hex(p: pchar; len: integer): shortstring;
const
HexDigits : array[0..15] of Char = '0123456789ABCDEF';
var
I: Integer;
B: Byte;
s: shortstring;
begin
s[0]:=char(len*2);
for I := 0 to len-1 do
begin
try
B := Byte(P[I]);
s[len*2-(I*2+1)] := HexDigits[B SHR $04];
s[len*2-I*2] := HexDigits[B AND $0F];
except
s[len*2-(i*2+1)]:= '?';
s[len*2-i*2] := '?';
end;
end;
result:=s;
end;
{ Konvertiert String mit Hexadezimal-Zahlen in Daten-Bytes
s: string, p: Zeiger auf Buffer, der die Daten aufnehmen soll }
procedure Hex2Data(s: shortstring; p: pchar);
var
i: integer;
len: byte;
begin
len:=length(s);
for i:= 0 to len div 2-1 do
begin
byte(p[i]):=byte(Hex2Dec(s[len-(i*2+1)]+s[len-i*2]));
end;
end;
{: checks for the length of s if specified data buf is equal specified string }
function IsDataEqual(buf: pointer; s: shortstring): boolean;
var
i: integer;
begin
for i:=1 to length(s) do
begin
if (byte(buf^) <> ord(s[i])) then
begin
result:=FALSE;
exit;
end;
inc(longword(buf));
end;
result:=TRUE;
end;
{: compares bytes of buf1 with buf2 and returns number of NOT equal bytes }
function BytesEqual(buf1, buf2: pointer; size: longword): longword;
var
i: longint;
notequal: longword;
begin
notequal:=0;
for i:=0 to size-1 do
begin
if byte(buf1^) <> byte(buf2^) then inc(notequal);
end;
result:=notequal;
end;
{: returns next text line of data stream }
function GetNextTextLine(var buf: pointer; maxbufpos: pointer): shortstring;
var
s: shortstring;
begin
s:='';
while (byte(buf^) <> $0D) AND (byte(pointer(longword(buf)+1)^) <> $0A)
AND (longword(buf) < longword(maxbufpos)) do
begin
s:=s + char(buf^);
inc(longword(buf));
end;
if longword(buf) < longword(maxbufpos) then inc(longword(buf), 2); // set new start
result:=s;
end;
function replace(s: string; old, new: char): string;
var
j: integer;
res: string;
begin
res:=s;
for j:=1 to length(res) do
if res[j]=old then res[j]:=new;
replace:=res;
end;
{: converts path+name to max. characters by replacing inner directories with '...' }
function AbbreviatePath(pathname: string; maxchars: integer): string;
var
i, dstart, dend, dlen: integer;
s: string;
begin
dstart:=0; dlen:=0;
i:=1;
while (i < length(pathname)) AND (length(pathname)-dlen+5 > maxchars) do
begin
if pathname[i] = '\' then
begin
if dstart = 0 then dstart := i
else begin
dend:=i;
dlen:=dend-dstart+1;
end;
end;
inc(i);
end;
s:=pathname;
if dlen > 0 then
begin
s:=copy(pathname, 1, dstart) + '...' + copy(pathname, dend, length(pathname)-dend+1);
end;
result:=s;
end;
function IsWinNT: boolean;
var
info: TOSVersionInfo;
begin
IsWinNT:=false;
info.dwOSVersionInfoSize:=sizeof(TOSVersionInfo);
if GetVersionEx(info) then
begin
if info.dwPlatformId = VER_PLATFORM_WIN32_NT then IsWinNT:=true;
end;
end;
function ShellGetSystemImageList(Large: boolean): HImageList;
var
SFI: TSHFileInfo;
begin
// SHGetFileInfo puts the requested information in the SFI variable, but it
// also can return the handle of the system image list. We just pass an
// empty file because we aren't interested in it, only the returned handle.
if Large then
Result := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
SHGFI_SYSICONINDEX or SHGFI_LARGEICON)
else
Result := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
end;
function ShellGetIconIndex(const APath: string; Attrs: DWORD): integer;
var
SFI: TSHFileInfo;
begin
// File doesn't exist, so Windows doesn't know what to do with it. We have
// to tell it by passing the attributes we want, and specifying the
// SHGFI_USEFILEATTRIBUTES flag so that the function knows to use them.
SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
Result := SFI.iIcon;
end;
function ShellGetFileInfo(const APath: string; Attrs: DWORD;
var Descr: string): integer;
var
SFI: TSHFileInfo;
begin
SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
Descr := SFI.szTypeName;
Result := SFI.iIcon;
end;
function ShellGetFileType(const APath: string; Attrs: DWORD;
var Descr: string): boolean;
var
SFI: TSHFileInfo;
begin
result:=(SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES) <> 0);
if result then Descr := SFI.szTypeName;
end;
function NewDiskFree(rootpath: string): longword;
var
secpclus, bytepsec, freeclus, totalclus: dword;
a: array[0..4] of char;
begin
StrPCopy(a, rootpath);
if GetDiskFreeSpace(a, secpclus, bytepsec, freeclus, totalclus) then
result:=(secpclus * bytepsec) * freeclus
else result:=0;
end;
function GetRootPath(drivepathname: string): string;
begin
result:=drivepathname[1]+':\';
end;
// Wie ExtractFileName, nur schneller!
function ExtractFileNameFaster(pathAndFile: string): string;
var
p1, len: integer;
begin
len:=length(pathAndFile);
p1:=len;
while (p1>0) AND (pathAndFile[p1] <> '\') do dec(p1);
result:=copy(pathAndFile, p1+1, len-p1);
end;
end.