sockpas.pas

delphi的 socket编程源码,从别的网站下的,挺好的

unit sockpas;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Registry, ScktComp;

type
  TForm1 = class(TForm)
    Socketconn: TServerSocket;
    procedure FormCreate(Sender: TObject);
    procedure SocketconnClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SocketconnAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
  function Encrypt(sCryptin: String ): String;
  function Decrypt(sCrypted: String): String;
  procedure GetRegistryValues;
  procedure regprogrome;
    { Private declarations }
  public
    socketcustom: TCustomWinSocket;
    { Public declarations }
  end;
const
  sRegisterKey = 'Software\HuaSheng\ycSoft\';
var
  Form1: TForm1;
  conn:string;
implementation

{$R *.dfm}
function TForm1.Decrypt(sCrypted: String): String;
var
  I, iKey: Word;
begin
  iKey:=12345;
  Result := sCrypted;
  for I := 1 to Length(sCrypted) do begin
    Result[I] := char(byte(sCrypted[I]) xor (iKey shr 10));
    iKey := (byte(sCrypted[I]) + iKey);// * 52845 + 22719;
  end;
end;

function TForm1.Encrypt(sCryptin: String ): String;
var
  I, iKey: Word;
begin
  iKey:=12345;
  Result:= sCryptin;
  for I := 1 to Length(sCryptin) do begin
    Result[I] := char(byte(sCryptin[I]) xor (iKey shr 10));
    iKey := (byte(Result[I]) + iKey);// * 52845 + 22719;
  end;
end;

procedure TForm1.GetRegistryValues;
var
databasetype:integer;
databaseserver,databasename,databaseuser,databasepassword,databaseyancao:string;
begin
databaseserver:='';
databasename:='';
databaseuser:='';
databasepassword:='';
  With TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKey(sRegisterKey + '数据库参数',False) then
    begin
      //0:MsSQL、1:Sybase、2:Oracle
      databasetype := strtoint(ReadString('DbType'));
      databaseserver := ReadString('DbServerName');
      databasename := ReadString('DbName');
      databaseyancao := ReadString('DbName1');
      databaseuser := Decrypt(ReadString('DbUserName'));
      databasepassword := Decrypt(ReadString('DbUserPwd'));
      CloseKey;
    end;
  finally
    Free;
  end;
  case databasetype of
     0: begin
         conn :='Provider=SQLOLEDB.1;Password='+databasepassword+';Persist Security Info=True;User ID='+databaseuser+';Initial Catalog=mis_sysinf;Data Source='+databaseserver;
         conn :=conn+'?'+'Provider=SQLOLEDB.1;Password='+databasepassword+';Persist Security Info=True;User ID='+databaseuser+';Initial Catalog=yancao;Data Source='+databaseserver;
        end;
     1:  begin
         conn :='Provider=Sybase.ASEOLEDBProvider.2;Initial Catalog=mis_sysinf;User ID='+databaseuser+';Password='+databasepassword+';Data Source='+databaseserver+';Persist Security Info=True';
         conn :=conn+'?'+'Provider=Sybase.ASEOLEDBProvider.2;Initial Catalog=yancao;User ID='+databaseuser+';Password='+databasepassword+';Data Source='+databaseserver+';Persist Security Info=True';
         end;
     else
        begin
        conn  :='Provider=MSDAORA.1;Password='+databasepassword+';User ID='+databaseuser+';Data Source='+databaseserver+';Persist Security Info=True';
        conn :=conn+'?'+'Provider=MSDAORA.1;Password='+databasepassword+';User ID='+databaseuser+';Data Source='+databaseserver+';Persist Security Info=True';
        end;
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
conn:='';
application.ShowMainForm:=false;
regprogrome;
try
 GetRegistryValues;
 Socketconn.Port:=5180;
 socketconn.Active:=true;
finally
end;
end;

procedure TForm1.SocketconnClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
  var
  year,month,day:word;
begin
  GetRegistryValues;
  decodedate(now,year,month,day);
  if year<=2005 then
    Socket.SendText(conn)
   //Socketconn.Socket.Connections[0].SendText(conn)
  else
    Socket.SendText('系统过期');
   //Socketconn.Socket.Connections[0].SendText('系统过期');
   socket.Close;
end;

procedure TForm1.SocketconnAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin

//socketcustom:=socket.Create(1);
//socketcustom:=Socket;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
application.ShowMainForm:=false;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Socketconn.Active:=false;
end;
procedure TForm1.regprogrome;
var
 rep:TRegistry;
begin
    try
    rep:=TRegistry.Create;
    rep.RootKey:=HKEY_LOCAL_MACHINE;
    rep.OpenKey('software\microsoft\windows\CurrentVersion\Run',true);
    rep.WriteString(application.Title,application.ExeName);
    finally
    end;
end;

end.