📄 sysutils2.pas
字号:
unit SysUtils2;
interface
uses windows,Winsock;
type
LongRec = packed record
case Integer of
0: (Lo, Hi: Word);
1: (Words: array[0..1] of Word);
2: (Bytes: array[0..3] of Byte);
end;
const
fmOpenRead = $0000;
fmOpenWrite = $0001;
fmOpenReadWrite = $0002;
fmShareDenyNone = $0040;
function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;
procedure FileClose(Handle: Integer);
function FileCreate(const FileName: string): Integer;
function FileSeek(Handle, Offset, Origin: Integer): Integer;
function FileOpen(const FileName: string; Mode: LongWord): Integer;
function LowerCase(const S: string): string;
function StrComp(const Str1, Str2: PChar): Integer; assembler;
function StrCopy(Dest: PChar; const Source: PChar): PChar;
function ExtractFilePath(path: string): string;
function ExtractFilename(const filename: string): string;
function AnsiCompareText(const S1, S2: string): Integer;
function UpperCase(const S: string): string;
function StrLen(const Str: PChar): Cardinal; assembler;
function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
assembler;
function StrPCopy(Dest: PChar; const Source: string): PChar;
function StrPas(const Str: PChar): string;
function IntToStr(const Value: Integer): string; //整数转换为AnsiString字符串
function Trim(const S: string): string;
function FileExists(const FileName: string): Boolean;
function StrIComp(const Str1, Str2: PChar): Integer; assembler;
function StrCat(Dest: PChar; const Source: PChar): PChar;
function StrLComp(S1, S2: PChar; MaxLen: Cardinal): Integer;
function FileSetAttr(const FileName: string; Attr: Integer): Integer;
function StrToBool(const S: string): Boolean;
function StrToInt(const S: string): Integer; //字符串转换成整数
function StrAlloc(Size: Cardinal): PChar;
procedure StrDispose(Str: PChar);
function AllocMem(Size: Cardinal): Pointer;
Function ResolveIP(HostName: String): String;
function ShellExecute(hWnd: HWND; Operation, FileName, Parameters,
Directory: PChar; ShowCmd: Integer): HINST; stdcall;
implementation
function ShellExecute; external 'shell32.dll' name 'ShellExecuteA';
Function ResolveIP(HostName: String): String;
Type
tAddr = Array[0..100] Of PInAddr;
pAddr = ^tAddr;
Var
I :Integer;
WSA :TWSAData;
PHE :PHostEnt;
P :pAddr;
Begin
Result := '';
WSAStartUp($101, WSA);
Try
PHE := GetHostByName(pChar(HostName));
If (PHE <> NIL) Then
Begin
P := pAddr(PHE^.h_addr_list);
I := 0;
While (P^[I] <> NIL) Do
Begin
Result := (inet_nToa(P^[I]^));
if Result<>'' then break;
Inc(I);
End;
End;
Except
End;
WSACleanUp;
End;
function AllocMem(Size: Cardinal): Pointer;
begin
GetMem(Result, Size);
FillChar(Result^, Size, 0);
end;
procedure StrDispose(Str: PChar);
begin
if Str <> nil then
begin
Dec(Str, SizeOf(Cardinal));
FreeMem(Str, Cardinal(Pointer(Str)^));
end;
end;
function FileSetAttr(const FileName: string; Attr: Integer): Integer;
begin
Result := 0;
if not SetFileAttributes(PChar(FileName), Attr) then
Result := GetLastError;
end;
function StrAlloc(Size: Cardinal): PChar;
begin
Inc(Size, SizeOf(Cardinal));
GetMem(Result, Size);
Cardinal(Pointer(Result)^) := Size;
Inc(Result, SizeOf(Cardinal));
end;
function StrToInt(const S: string): Integer; //字符串转换成整数
var
E: Integer;
begin
Val(S, Result, E);
end;
function IntToStr(const Value: Integer): string; //整数转换为AnsiString字符串
var
S: string[11];
begin
Str(Value, S);
Result := S;
end;
function StrToBool(const S: string): Boolean;
begin
if s = '0' then
Result := False
else
result := true;
end;
function StrEnd(const Str: PChar): PChar; assembler;
asm
MOV EDX,EDI
MOV EDI,EAX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
LEA EAX,[EDI-1]
MOV EDI,EDX
end;
function StrCat(Dest: PChar; const Source: PChar): PChar;
begin
StrCopy(StrEnd(Dest), Source);
Result := Dest;
end;
function StrPCopy(Dest: PChar; const Source: string): PChar;
begin
Result := StrLCopy(Dest, PChar(Source), Length(Source));
end;
function StrCopy(Dest: PChar; const Source: PChar): PChar;
asm
PUSH EDI
PUSH ESI
MOV ESI,EAX
MOV EDI,EDX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
NOT ECX
MOV EDI,ESI
MOV ESI,EDX
MOV EDX,ECX
MOV EAX,EDI
SHR ECX,2
REP MOVSD
MOV ECX,EDX
AND ECX,3
REP MOVSB
POP ESI
POP EDI
end;
function StrComp(const Str1, Str2: PChar): Integer; assembler;
asm
PUSH EDI
PUSH ESI
MOV EDI,EDX
MOV ESI,EAX
MOV ECX,0FFFFFFFFH
XOR EAX,EAX
REPNE SCASB
NOT ECX
MOV EDI,EDX
XOR EDX,EDX
REPE CMPSB
MOV AL,[ESI-1]
MOV DL,[EDI-1]
SUB EAX,EDX
POP ESI
POP EDI
end;
function LowerCase(const S: string): string;
var
Ch: Char;
L: Integer;
Source, Dest: PChar;
begin
L := Length(S);
SetLength(Result, L);
Source := Pointer(S);
Dest := Pointer(Result);
while L <> 0 do
begin
Ch := Source^;
if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);
Dest^ := Ch;
Inc(Source);
Inc(Dest);
Dec(L);
end;
end;
function StrScan(const Str: PChar; Chr: Char): PChar;
begin
Result := Str;
while Result^ <> Chr do
begin
if Result^ = #0 then
begin
Result := nil;
Exit;
end;
Inc(Result);
end;
end;
function ExtractFilePath(path: string): string;
var
i: integer;
begin
i := length(path);
while i >= 1 do
begin
if (path[i] = '\') or (path[i] = '/') or (path[i] = ':') then
break;
dec(i);
end;
result := copy(path, 1, i);
end;
function AnsiCompareText(const S1, S2: string): Integer;
begin
Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1),
Length(S1), PChar(S2), Length(S2)) - 2;
end;
function ExtractFilename(const filename: string): string;
var
I: Integer;
begin
i := length(filename);
while i >= 1 do
begin
if (filename[i] = '/') or (filename[i] = '\') or (filename[i] = ':') then
begin
result := copy(filename, i + 1, maxint);
exit;
end;
dec(i);
end;
result := filename;
end;
//转换
{function ExtractFileName(const Path: string): string;
var
I: Integer;
L: Integer;
Ch: Char;
begin
Result := Path;
L := Length(Path); //把路径转换为闭合
for I := L downto 1 do
begin
Ch := Path[I];
if (Ch = '\') or (Ch = '/') then
begin
Result := Copy(Path, I + 1, L - I);
Break;
end;
end;
end;
}
function UpperCase(const S: string): string;
var
Ch: Char;
L: Integer;
Source, Dest: PChar;
begin
L := Length(S);
SetLength(Result, L);
Source := Pointer(S);
Dest := Pointer(Result);
while L <> 0 do
begin
Ch := Source^;
if (Ch >= 'a') and (Ch <= 'z') then
Dec(Ch, 32);
Dest^ := Ch;
Inc(Source);
Inc(Dest);
Dec(L);
end;
end;
function StrLen(const Str: PChar): Cardinal; assembler;
asm
MOV EDX,EDI
MOV EDI,EAX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
MOV EAX,0FFFFFFFEH
SUB EAX,ECX
MOV EDI,EDX
end;
function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
assembler;
asm
PUSH EDI
PUSH ESI
PUSH EBX
MOV ESI,EAX
MOV EDI,EDX
MOV EBX,ECX
XOR AL,AL
TEST ECX,ECX
JZ @@1
REPNE SCASB
JNE @@1
INC ECX
@@1: SUB EBX,ECX
MOV EDI,ESI
MOV ESI,EDX
MOV EDX,EDI
MOV ECX,EBX
SHR ECX,2
REP MOVSD
MOV ECX,EBX
AND ECX,3
REP MOVSB
STOSB
MOV EAX,EDX
POP EBX
POP ESI
POP EDI
end;
function StrPas(const Str: PChar): string;
begin
Result := Str;
end;
{function Inttostr(const Int: integer): string;
var
d, m: integer;
A:boolean;
begin
if Int=0 then
begin
result:='0';
exit;
end;
result:='';
A:= int >= 0;
if A then m := int
else m := -int;
result:='';
while m <> 0 do
begin
d := m mod 10;
m := m div 10;
Result := chr(d + 48) + Result;
end;
if not A then Result:='-'+Result;
end;
}
function Trim(const S: string): string;
var
I, L: Integer;
begin
L := Length(S);
I := 1;
while (I <= L) and (S[I] <= ' ') do
Inc(I);
if I > L then
Result := ''
else
begin
while S[L] <= ' ' do
Dec(L);
Result := Copy(S, I, L - I + 1);
end;
end;
function StrIComp(const Str1, Str2: PChar): Integer; assembler;
asm
PUSH EDI
PUSH ESI
MOV EDI,EDX
MOV ESI,EAX
MOV ECX,0FFFFFFFFH
XOR EAX,EAX
REPNE SCASB
NOT ECX
MOV EDI,EDX
XOR EDX,EDX
@@1: REPE CMPSB
JE @@4
MOV AL,[ESI-1]
CMP AL,'a'
JB @@2
CMP AL,'z'
JA @@2
SUB AL,20H
@@2: MOV DL,[EDI-1]
CMP DL,'a'
JB @@3
CMP DL,'z'
JA @@3
SUB DL,20H
@@3: SUB EAX,EDX
JE @@1
@@4: POP ESI
POP EDI
end;
function FileAge(const FileName: string): Integer;
var
Handle: THandle;
FindData: TWin32FindData;
LocalFileTime: TFileTime;
begin
Handle := FindFirstFile(PChar(FileName), FindData);
if Handle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(Handle);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
LongRec(Result).Lo) then Exit;
end;
end;
Result := -1;
end;
function FileExists(const FileName: string): Boolean;
begin
Result := FileAge(FileName) <> -1;
end;
{function FileExists(const FileName: string): Boolean;
var
FileData: TWin32FindData;
//当利用FindFirst和FindNext函数找到一个文件后,利用这个类型可以获得文件的属性、大小和修改时间等信息
hFile: Cardinal;
begin
hFile := FindFirstFile(pChar(FileName), FileData);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
Result := True;
Windows.FindClose(hFile);
end
else
Result := False;
end;
}
function FileOpen(const FileName: string; Mode: LongWord): Integer;
const
AccessMode: array[0..2] of LongWord = (
GENERIC_READ,
GENERIC_WRITE,
GENERIC_READ or GENERIC_WRITE);
ShareMode: array[0..4] of LongWord = (
0,
0,
FILE_SHARE_READ,
FILE_SHARE_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
Result := -1;
if ((Mode and 3) <= fmOpenReadWrite) and
((Mode and $F0) <= fmShareDenyNone) then
Result := Integer(CreateFile(PChar(FileName), AccessMode[Mode and 3],
ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0));
end;
function FileSeek(Handle, Offset, Origin: Integer): Integer;
begin
{$IFDEF MSWINDOWS}
Result := SetFilePointer(THandle(Handle), Offset, nil, Origin);
{$ENDIF}
{$IFDEF LINUX}
Result := __lseek(Handle, Offset, Origin);
{$ENDIF}
end;
function FileCreate(const FileName: string): Integer;
begin
Result := Integer(CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
end;
function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;
begin
{$IFDEF MSWINDOWS}
if not WriteFile(THandle(Handle), Buffer, Count, LongWord(Result), nil) then
Result := -1;
{$ENDIF}
{$IFDEF LINUX}
Result := __write(Handle, Buffer, Count);
{$ENDIF}
end;
procedure FileClose(Handle: Integer);
begin
{$IFDEF MSWINDOWS}
CloseHandle(THandle(Handle));
{$ENDIF}
{$IFDEF LINUX}
__close(Handle); // No need to unlock since all locks are released on close.
{$ENDIF}
end;
function StrLComp(S1, S2: PChar; MaxLen: Cardinal): Integer;
begin
Result := CompareString(LOCALE_USER_DEFAULT, 0,
S1, MaxLen, S2, MaxLen) - 2;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -