delphi常用函数和方法

uses ShellApi, ActiveX, ComObj, ShlObj;

function HasText(Text: string; const Values: array of string): Boolean;
var
i: Integer;
begin
Result := True;
Text := AnsiLowerCase(Text);
for i := Low(Values) to High(Values) do
if Pos(Values[i], Text) > 0 then
Exit;
Result := False;
end;

HasText(Line, ['hint: ', 'hinweis: ', 'suggestion: ', 'conseil: ']) ;

function PosLast(Ch: Char; const S: string): Integer;
begin
for Result := Length(S) downto 1 do
if S[Result] = Ch then
Exit;
Result := 0;
end;

==================================

function StrMatches(const Substr, S: string; const Index: SizeInt=1): Boolean;
var
StringPtr: PChar;
PatternPtr: PChar;
StringRes: PChar;
PatternRes: PChar;
begin
if SubStr = '' then
raise Exception.Create('Blank Search String');

Result := SubStr = '*';

if Result or (S = '') then
Exit;

if (Index <= 0) or (Index > Length(S)) then
raise Exception.Create('Argument Out Of Range');

StringPtr := PChar(@S[Index]);
PatternPtr := PChar(SubStr);
StringRes := nil;
PatternRes := nil;

repeat
repeat
case PatternPtr^ of
#0:
begin
Result := StringPtr^ = #0;
if Result or (StringRes = nil) or (PatternRes = nil) then
Exit;

StringPtr := StringRes;
PatternPtr := PatternRes;
Break;
end;
'*':
begin
Inc(PatternPtr);
PatternRes := PatternPtr;
Break;
end;
'?':
begin
if StringPtr^ = #0 then
Exit;
Inc(StringPtr);
Inc(PatternPtr);
end;
else
begin
if StringPtr^ = #0 then
Exit;
if StringPtr^ <> PatternPtr^ then
begin
if (StringRes = nil) or (PatternRes = nil) then
Exit;
StringPtr := StringRes;
PatternPtr := PatternRes;
Break;
end
else
begin
Inc(StringPtr);
Inc(PatternPtr);
end;
end;
end;
until False;

repeat
case PatternPtr^ of
#0:
begin
Result := True;
Exit;
end;
'*':
begin
Inc(PatternPtr);
PatternRes := PatternPtr;
end;
'?':
begin
if StringPtr^ = #0 then
Exit;
Inc(StringPtr);
Inc(PatternPtr);
end;
else
begin
repeat
if StringPtr^ = #0 then
Exit;
if StringPtr^ = PatternPtr^ then
Break;
Inc(StringPtr);
until False;
Inc(StringPtr);
StringRes := StringPtr;
Inc(PatternPtr);
Break;
end;
end;
until False;
until False;
end;

function IsFileNameMatch(FileName: string; const Mask: string;
const CaseSensitive: Boolean): Boolean;
begin
Result := True;
{$IFDEF MSWINDOWS}
if (Mask = '') or (Mask = '*') or (Mask = '*.*') then
Exit;
if Pos('.', FileName) = 0 then
FileName := FileName + '.';
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
if (Mask = '') or (Mask = '*') then
Exit;
{$ENDIF UNIX}
if CaseSensitive then
Result := StrMatches(Mask, FileName)
else
Result := StrMatches(AnsiUpperCase(Mask), AnsiUpperCase(FileName));
end;

type
TSHDeleteOption = (doSilent, doAllowUndo, doFilesOnly);
TSHDeleteOptions = set of TSHDeleteOption;
TSHRenameOption = (roSilent, roRenameOnCollision);
TSHRenameOptions = set of TSHRenameOption;
TSHCopyOption = (coSilent, coAllowUndo, coFilesOnly, coNoConfirmation);
TSHCopyOptions = set of TSHCopyOption;
TSHMoveOption = (moSilent, moAllowUndo, moFilesOnly, moNoConfirmation);
TSHMoveOptions = set of TSHMoveOption;

const
FOF_COMPLETELYSILENT = FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_NOCONFIRMMKDIR;

function DeleteOptionsToCardinal(Options: TSHDeleteOptions): Cardinal;
begin
Result := 0;
if doSilent in Options then
Result := Result or FOF_COMPLETELYSILENT;
if doAllowUndo in Options then
Result := Result or FOF_ALLOWUNDO;
if doFilesOnly in Options then
Result := Result or FOF_FILESONLY;
end;

// memory initialization
procedure ResetMemory(out P; Size: Longint);
begin
if Size > 0 then
begin
Byte(P) := 0;
FillChar(P, Size, 0);
end;
end;

function SHDeleteFiles(Parent: THandle; const Files: string;
Options: TSHDeleteOptions): Boolean;
var
FileOp: TSHFileOpStruct;
Source: string;
begin
ResetMemory(FileOp, SizeOf(FileOp));
with FileOp do
begin
Wnd := Parent;
wFunc := FO_DELETE;
Source := Files + #0#0;
pFrom := PChar(Source);
fFlags := DeleteOptionsToCardinal(Options);
end;
Result := SHFileOperation(FileOp) = 0;
end;

function FileDelete(const FileName: string; MoveToRecycleBin: Boolean = False): Boolean;
{$IFDEF MSWINDOWS}
begin
if MoveToRecycleBin then
Result := SHDeleteFiles(0, FileName, [doSilent, doAllowUndo, doFilesOnly])
else
Result := DeleteFile(PChar(FileName));
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
begin
Result := remove(PChar(FileName)) <> -1;
end;
{$ENDIF UNIX}

function RenameOptionsToCardinal(Options: TSHRenameOptions): Cardinal;
begin
Result := 0;
if roRenameOnCollision in Options then
Result := Result or FOF_RENAMEONCOLLISION;
if roSilent in Options then
Result := Result or FOF_COMPLETELYSILENT;
end;

function SHRenameFile(const Src, Dest: string; Options: TSHRenameOptions): Boolean;
var
FileOp: TSHFileOpStruct;
Source, Destination: string;
begin
ResetMemory(FileOp, SizeOf(FileOp));
with FileOp do
begin
Wnd := GetDesktopWindow;
wFunc := FO_RENAME;
Source := Src + #0#0;
Destination := Dest + #0#0;
pFrom := PChar(Source);
pTo := PChar(Destination);
fFlags := RenameOptionsToCardinal(Options);
end;
Result := SHFileOperation(FileOp) = 0;
end;

巴特西

delphi常用函数和方法

最新文章

热门文章