main.pas

RSA Samples Source Code for Delphi

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls, RSA;

type
  TChatForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    FileConnectItem: TMenuItem;
    FileListenItem: TMenuItem;
    StatusBar1: TStatusBar;
    Bevel1: TBevel;
    Panel1: TPanel;
    Memo2: TMemo;
    N1: TMenuItem;
    Disconnect1: TMenuItem;
    ServerSocket: TServerSocket;
    ClientSocket: TClientSocket;
    Button1: TButton;
    N2: TMenuItem;
    Info1: TMenuItem;
    Timer1: TTimer;
    Memo1: TMemo;
    procedure FileListenItemClick(Sender: TObject);
    procedure FileConnectItemClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure ServerSocketError(Sender: TObject; Number: Smallint;
      var Description: string; Scode: Integer; const Source,
      HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
    procedure Disconnect1Click(Sender: TObject);
    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketAccept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Info1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseEnter(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private

  public

  protected
    IsServer: Boolean;
    procedure WndProc(var msg: TMessage); override;
  end;

var
  ChatForm: TChatForm;
  Server: string;
  Keysize_s, Port_s: string;
  Keysize, Port: integer;
  Keys_own, Keys_foreign: TRSAKey;
  one, two: boolean;
procedure splitkeys(s: string);
function GetTime: string;

const
  STD_PORT = 88;
  STD_KEYSIZE = 512;

implementation

{$R *.DFM}

procedure TChatForm.WndProc(var msg: TMessage);
begin
  if msg.Msg = WM_ACTIVATEAPP then
  begin
    PRect(msg.LParam);
    Timer1.Enabled := False;
  end;
  inherited WndProc(msg);
end;

function GetTime: string;
var
  a: TDateTime;
begin
  a := Time(); // Systemzeit auslesen.
  result := FormatDateTime('hh:nn:ss', a);
   // Zeit formatieren und ausgeben.
end;

procedure splitkeys(s: string);
var
  I: Integer;
  b: boolean;
begin
  b := false;
  Keys_foreign.e := '';
  Keys_foreign.n := '';
  for I := 1 to length(s) do
  begin
    if b = false then
    begin
      if s[i] <> ';' then
      begin
        Keys_foreign.e := Keys_foreign.e + s[i];
      end
      else
        if s[i] = ';' then
      begin
        b := true;
      end;
    end
    else
      if b = true then
    begin
      Keys_foreign.n := Keys_foreign.n + s[i];
    end;
  end;
end;

procedure TChatForm.FileListenItemClick(Sender: TObject);
begin
  FileListenItem.Checked := not FileListenItem.Checked;
  if FileListenItem.Checked then
  begin
    ClientSocket.Active := False;
    ServerSocket.Active := True;
    Statusbar1.Panels[0].Text := 'Listening...';
  end
  else
  begin
    if ServerSocket.Active then
      ServerSocket.Active := False;
    Statusbar1.Panels[0].Text := '';
  end;
end;

procedure TChatForm.FileConnectItemClick(Sender: TObject);
begin
  if ClientSocket.Active then
    ClientSocket.Active := False;
  if InputQuery('Computer to connect to', 'Address Name:', Server) then
    if Length(Server) > 0 then
      with ClientSocket do
      begin
        Port := Port;
        Host := Server;
        Active := True;
        FileListenItem.Checked := False;
      end;
end;

procedure TChatForm.Exit1Click(Sender: TObject);
begin
  ServerSocket.Close;
  ClientSocket.Close;
  Close;
end;

procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  geheimtext, klartext: string;
begin
  geheimtext := '';
  klartext := '';
  if Key = VK_Return then
    if IsServer then
    begin
      klartext := Memo1.Text;
      Memo2.Lines.Add('Ich (' + GetTime() + '): ' + klartext);
      geheimtext := RSA_dividedstring_encrypt(klartext, Keys_foreign.e,
        Keys_foreign.n);
      ServerSocket.Socket.Connections[0].SendText(geheimtext);
    end
    else
    begin
      //Memo1.Lines[Memo1.Lines.Count - 1];
      klartext := Memo1.Text;
      Memo2.Lines.Add('Ich (' + GetTime() + '): ' + klartext);
      geheimtext := RSA_dividedstring_encrypt(klartext, Keys_foreign.e,
        Keys_foreign.n);
      ClientSocket.Socket.SendText(geheimtext);
    end;
end;

procedure TChatForm.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Return then
    Memo1.Clear;
end;

procedure TChatForm.FormCreate(Sender: TObject);
var
  item1, item2: integer;
  i1, i2: boolean;
begin
  ChatForm.Left := Screen.Width div 2 - 195;
  ChatForm.Top := Screen.Height div 2 - 215;
  i1 := false;
  i2 := false;
  Memo1.Clear;
  FileListenItemClick(nil);
  Port := 0;
  Keysize := 0;

  if ParamStr(1) <> '' then
    i1 := true;
  if ParamStr(2) <> '' then
    i2 := true;

  if i1 = true then
  begin
    try
      Item1 := strtoint(ParamStr(1));
      if (Item1 <= 1024) and (Item1 >= 128) then
        Keysize := item1;
    except
      if Keysize = 0 then
        Keysize := STD_KEYSIZE;
    end;
  end
  else
  begin
    InputQuery('Enter Keysize', 'Keysize:', Keysize_s);
    if Keysize_s = '' then
      Keysize := STD_KEYSIZE
    else
      Keysize := strtoint(Keysize_s);
  end;

  if i2 = true then
  begin
    try
      Item2 := strtoint(ParamStr(2));
      if (Item2 <= 65000) and (Item2 >= 1) then
        Port := item2;
    except
      if Port = 0 then
        Port := STD_Port;
    end;
  end
  else
  begin
    InputQuery('Enter Port', 'Port:', Port_s);
    if Port_s = '' then
      Port := STD_PORT
    else
      Port := strtoint(Port_s);
  end;

  Keys_own := GetKeyPair(Keysize);
  ServerSocket.Port := Port;
  one := true;
  two := false;
end;

procedure TChatForm.Info1Click(Sender: TObject);
begin
  ShowMessage('