SRL Archive - Delphi/FPC Help and Tutorials

I needed a small chat thingy, which i could use to stay in contact with my brother :'D…

This is basicly a chat client and server, but its intended to only connect 2 pc's…

It Runs in the Systray and is designed to not annoy the user too much :).

Usage:
Start 2chat.
Put in a Name.
@ CLient Ip, there comes the ip of the PC you want to chat with.

Do that for both pc's and you're set.

I' suggest to put a shortcut to the programme in the startup folder.

The advantage of this kind of chat is:
1. It works even if your internet is down.
2. Its simple
3. Its not annoying.. like … uhm… msn…
x. It also has an auto AFK feature, so you can see if your client is currently on their pc.

~caused

// sauce for anyone interested :3…

unit sauce;
//{$APPTYPE CONSOLE}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdTCPConnection, IdTCPClient, IdBaseComponent, IdComponent,
  IdTCPServer, StdCtrls, ExtCtrls,IniFiles, ShellApi, ToolWin, ComCtrls,CoolTrayIcon,
  TextTrayIcon, Menus, ImgList, MPlayer,MMSystem ;

const
  WM_NOTIFYICON  = WM_USER+333;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    Button1: TButton;
    IdTCPClient1: TIdTCPClient;
    Memo1: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    CoolTrayIcon1: TCoolTrayIcon;
    PopupMenu1: TPopupMenu;
    Exit1: TMenuItem;
    ResetUsernameIP1: TMenuItem;
    Timer2: TTimer;
    Timer3: TTimer;
    ProgressBar1: TProgressBar;
    Label3: TLabel;
    Label4: TLabel;
    Timer4: TTimer;
    ImageList1: TImageList;
    RichEdit1: TRichEdit;
    Timer5: TTimer;
    Timer1: TTimer;
    Label5: TLabel;
    Timer6: TTimer;
    Timer7: TTimer;
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure CoolTrayIcon1Click(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
    procedure RichEdit1Click(Sender: TObject);
    procedure RichEdit1Change(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure ResetUsernameIP1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Timer4Timer(Sender: TObject);
    procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure Timer5Timer(Sender: TObject);
    procedure Label5Click(Sender: TObject);
    procedure Timer6Timer(Sender: TObject);
    procedure Timer7Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private

  public


  end;

var
  Form1: TForm1;
  Username,ClientIp : String;
  ini: TIniFile;
  xw,xh : Integer;
  pro : Integer;
  rdy2go : Boolean;

  sendit : Boolean;
  countit : Integer;

  FirstRun: Boolean;

  TrayBlink : Boolean;

  CurPos : TPOINT;
  
implementation

{$R *.dfm}

function DeleteLineBreaks(const S: string): string;
var
   Source, SourceEnd: PChar;
begin
  Source := Pointer(S) ;
  SourceEnd := Source + Length(S) ;
  while Source < SourceEnd do
  begin
    case Source^ of
      #10: Source^ := #32;
      #13: Source^ := #32;
    end;
     Inc(Source) ;
   end;
  Result := S;
End;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  Command : String;
  WinPath: array[0..MAX_PATH + 1] of char;
  winpatch2 : String;
  testxx : PAnsiChar;
begin

  Command := AThread.Connection.ReadLn;

  If not(length(command) < 1) then
  begin
    Timer1.Enabled := TRUE;
    pro := 0;

    Memo1.Text := Memo1.Text+#13+#10+Command;
    SendMessage(Memo1.Handle,WM_VSCROLL,SB_BOTTOM,0);
    GetWindowsDirectory(WinPath,MAX_PATH);

    winpatch2 := StrPas(WinPath);
    winpatch2 := winpatch2+'/Media/NOTIFY.WAV';
    testxx := PAnsiChar(winpatch2);

    sndPlaySound(testxx,SND_SYNC);

    //MessageBeep(1);


    Form1.Visible := True;

end;


end;


function GetTaskbarHeight: integer;
var 
  SysTray: Windows.HWND; 
  Rect: TRect; 
begin 
  Result := -1; 
  SysTray := FindWindow('Shell_TrayWnd', nil); 
  If SysTray <> INVALID_HANDLE_VALUE then begin 
    If GetWindowRect(SysTray, Rect) then begin 
      Result := Screen.Height - Rect.Top; 
    end; 
  end; 
end; 

procedure TForm1.FormCreate(Sender: TObject);
begin

  CoolTrayIcon1.IconVisible:= True;
  FirstRun := True;
  CoolTrayIcon1.MinimizeToTray := True;

  CoolTrayIcon1.IconIndex := 1;
  xw:=screen.Monitors[0].Width;
  xh:=screen.Monitors[0].Height;

  Label4.Caption := 'Init/Connect';

  IdTCPServer1.Active := True;

  ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+'startup.ini');

  Username := ini.ReadString('User','Name','0');

  ClientIp := ini.ReadString('ConnectTo','IP','0');


  ini.free;
  rdy2go := False;

  GetCursorPos(CurPos); // FÜR AFK MODUS

  Button1.Enabled:=False;

    If (ClientIP <> '0') AND (Username <> '0') then
    begin
      Memo1.Visible:= True;
      RichEdit1.Visible := True;
      Button1.Visible := True;

      Button3.Visible:=False;
      Edit1.Visible:=False;
      Edit2.Visible:=False;
      Label1.Visible :=False;
      Label2.Visible:=False;

      Form1.Left := xw-Form1.ClientWidth;
      Form1.Top := xh-Form1.ClientHeight-GetTaskbarHeight;

      rdy2go := True;
end else
begin
  Memo1.Visible:= False;
  RichEdit1.Visible := False;
  Button1.Visible := False;

  Button3.Visible:=True;
  Edit1.Visible:=True;
  Edit2.Visible:=True;
  Label1.Visible :=True;
  Label2.Visible:=True;
end;
end;




procedure TForm1.Button1Click(Sender: TObject);
var
  buff : String;
begin
  IF IdTCPClient1.Connected then
  begin
    buff := DeleteLineBreaks(RichEdit1.Text);

    Memo1.Text := Memo1.Text+#13+#10+username+'> '+buff;


    try
      IdTCPClient1.WriteLn(username+'> '+buff);
    except
      label4.caption := 'NOT SENT';
    end;
      RichEdit1.Clear;

      RichEdit1.SetFocus;
      RichEdit1.SelStart := 0;
      RichEdit1.Lines.Delete(0);

      If FirstRun then
      begin
        Memo1.Lines.Delete(0);
        FirstRun := FALSE;
      end;

    Button1.Enabled := FALSE;
    Timer5.Enabled:= TRUE;

    SendMessage(Memo1.Handle,WM_VSCROLL,SB_BOTTOM,0);
  end else
  begin
    Button1.enabled := False;
    Label4.Caption := 'Connecting';
  end;

end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
  If  rdy2go  then
  begin
    IF TrayBlink then
    begin
      CoolTrayIcon1.IconIndex := 3;
      TrayBlink := FALSE;
    end else
    begin
      CoolTrayIcon1.IconIndex := 2;
      TrayBlink := TRUE;
    end;
  end;
end;



function IsWrongIP(ip: string): Boolean;
var 
  z, i: byte; 
  st: array[1..3] of byte; 
const 
  ziff = ['0'..'9']; 
begin 
  st[1]  := 0; 
  st[2]  := 0; 
  st[3]  := 0; 
  z      := 0; 
  Result := False; 
  for i := 1 to Length(ip) do if ip[i] in ziff then 
  else 
  begin 
    if ip[i] = '.' then 
    begin 
      Inc(z); 
      if z < 4 then st[z] := i 
      else 
      begin 
        IsWrongIP := True; 
        Exit; 
      end; 
    end 
    else 
    begin 
      IsWrongIP := True; 
      Exit; 
    end; 
  end; 
  if (z <> 3) or (st[1] < 2) or (st[3] = Length(ip)) or (st[1] + 2 > st[2]) or 
    (st[2] + 2 > st[3]) or (st[1] > 4) or (st[2] > st[1] + 4) or (st[3] > st[2] + 4) then 
  begin 
    IsWrongIP := True; 
    Exit; 
  end; 
  z := StrToInt(Copy(ip, 1, st[1] - 1)); 
  if (z > 255) or (ip[1] = '0') then 
  begin 
    IsWrongIP := True; 
    Exit; 
  end; 
  z := StrToInt(Copy(ip, st[1] + 1, st[2] - st[1] - 1)); 
  if (z > 255) or ((z <> 0) and (ip[st[1] + 1] = '0')) then 
  begin 
    IsWrongIP := True; 
    Exit; 
  end; 
  z := StrToInt(Copy(ip, st[2] + 1, st[3] - st[2] - 1)); 
  if (z > 255) or ((z <> 0) and (ip[st[2] + 1] = '0')) then 
  begin 
    IsWrongIP := True; 
    Exit; 
  end; 
  z := StrToInt(Copy(ip, st[3] + 1, Length(ip) - st[3])); 
  if (z > 255) or ((z <> 0) and (ip[st[3] + 1] = '0')) then 
  begin 
    IsWrongIP := True; 
    Exit; 
  end; 
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+'startup.ini');
  // If Username = '0' then
  //    begin
  ini.WriteString('User','Name',Edit1.Text);
  //  end;
    If not IsWrongIP(Edit2.Text) then
      ini.WriteString('ConnectTo','IP',Edit2.Text)
      else
        Edit2.Text := 'INVALID IP!!';

     Username := ini.ReadString('User','Name','0');

     ClientIp := ini.ReadString('ConnectTo','IP','0');

     If not((ClientIP = '0')AND not(Username='0')) then
     begin
       Memo1.Visible:= True;
       RichEdit1.Visible := True;
       Button1.Visible := True;

       Button3.Visible:=False;
       Edit1.Visible:=False;
       Edit2.Visible:=False;
       Label1.Visible :=False;
       Label2.Visible:=False;

       Form1.Left := xw-Form1.ClientWidth;
       Form1.Top := xh-Form1.ClientHeight-GetTaskbarHeight;
     
       rdy2go := True;
     end;
 ini.free;
end;


procedure TForm1.Exit1Click(Sender: TObject);
begin

  Application.Terminate;

end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
If  rdy2go  then
begin

  pro := pro +1;
  ProgressBar1.Position := pro;
If pro >= 10 then
begin
  Form1.Visible := False;
  Timer2.Enabled := False;
  pro := 0;
end;
end;

end;

procedure TForm1.Timer3Timer(Sender: TObject);
begin
If  rdy2go  then
begin
  Timer2.Enabled := True;

end;
end;

procedure TForm1.CoolTrayIcon1Click(Sender: TObject);
begin
  Form1.Visible := True;
  Timer1.Enabled := FALSE;

If not CoolTrayIcon1.IconIndex = 0 then
  CoolTrayIcon1.IconIndex := 2;
end;

procedure TForm1.Memo1Click(Sender: TObject);
begin
  Timer2.Enabled := False;
  ProgressBar1.Position := pro;
  pro := 0;
  Timer1.Enabled := FALSE;
If not CoolTrayIcon1.IconIndex = 0 then
  CoolTrayIcon1.IconIndex := 2;
end;

procedure TForm1.RichEdit1Click(Sender: TObject);
begin
  Timer2.Enabled := False;
  ProgressBar1.Position := pro;
  pro := 0;
If not CoolTrayIcon1.IconIndex = 0 then
  CoolTrayIcon1.IconIndex := 2;
end;

procedure TForm1.RichEdit1Change(Sender: TObject);
begin
  Timer2.Enabled := False;
  ProgressBar1.Position := pro;
  pro := 0;
  Timer1.Enabled := FALSE;

  If not CoolTrayIcon1.IconIndex = 0 then
    CoolTrayIcon1.IconIndex := 2;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  Timer2.Enabled := False;
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
  Timer2.Enabled := False;
end;

procedure TForm1.ResetUsernameIP1Click(Sender: TObject);
begin
  Memo1.Visible:= False;
  RichEdit1.Visible := False;
  Button1.Visible := False;

  Button3.Visible:=True;
  Edit1.Visible:=True;
  Edit2.Visible:=True;
  Label1.Visible :=True;
  Label2.Visible:=True;
  Form1.Visible := True;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
ProgressBar1.Position := pro;
pro := 0;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  ProgressBar1.Position := pro;
  pro := 0;
  Timer1.Enabled := FALSE;
  If not CoolTrayIcon1.IconIndex = 0 then
    CoolTrayIcon1.IconIndex := 2;
  end;

procedure TForm1.Timer4Timer(Sender: TObject);
begin
If  rdy2go  then
begin

If not IdTCPClient1.Connected then
begin
  Button1.Enabled := FALSE;
  Label4.Caption := 'Connecting';
  IdTCPClient1.Host := ClientIp;
  IdTCPClient1.Port := 9535;
  CoolTrayIcon1.IconIndex := 0;

try
 IdTCPClient1.Connect(700);
 except
     CoolTrayIcon1.IconIndex := 0;
 end;

end;

 If IdTCPCLient1.Connected then
 begin
  Label4.Caption := 'Connected';
  CoolTrayIcon1.IconIndex := 2;
  Button1.Enabled := TRUE;
 end;




end;

end;

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Timer1.Enabled := FALSE;
If not CoolTrayIcon1.IconIndex = 0 then
  CoolTrayIcon1.IconIndex := 2;

   if GetAsyncKeyState(VK_LCONTROL)  <> 0 then
   begin
   sendit := FALSE
//   WriteLn('down')
   end else
   sendit := TRUE;

end;



procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Timer1.Enabled := FALSE;
If not CoolTrayIcon1.IconIndex = 0 then
  CoolTrayIcon1.IconIndex := 2;

If IDtcpclient1.Connected AND Button1.enabled then
begin
  If (GetAsyncKeyState(VK_RETURN)<>0) AND sendit then
  begin
    Button1.Click;
    RichEdit1.SelStart := 0;
  end;
end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  pro := 0;
end;

procedure TForm1.Timer5Timer(Sender: TObject);
begin
  Button1.Enabled := TRUE;
  Timer5.Enabled := FALSE;
end;

procedure TForm1.Label5Click(Sender: TObject);
begin
  Form1.Visible := FALSE;
end;

procedure TForm1.Timer6Timer(Sender: TObject);
var
  checkitx : TPOINT;
begin
If rdy2go AND IDtcpclient1.Connected then
begin
  GetCursorPos(checkitx);
if (CurPos.x = checkitx.x)AND (CurPos.y = checkitx.y) then
begin
  Memo1.Text := Memo1.Text+#13+#10+'< '+username+' is AFK';
  SendMessage(Memo1.Handle,WM_VSCROLL,SB_BOTTOM,0);
  try
    IdTCPClient1.WriteLn('< '+username+' is AFK');
  except
    label4.caption := 'NOT SENT';
  end;
    Timer6.Enabled := FALSE;
    Timer7.Enabled := TRUE;
end;
  GetCursorPos(CurPos);
end;

end;

procedure TForm1.Timer7Timer(Sender: TObject);
var
  tempcur : TPOINT;
begin
  GetCursorPos(tempcur);
If not (tempcur.x = CurPos.x) AND not(tempcur.y = CurPos.y) then
begin
  Memo1.Text := Memo1.Text+#13+#10+'< '+username+' is BACK';
  SendMessage(Memo1.Handle,WM_VSCROLL,SB_BOTTOM,0);
  try
    IdTCPClient1.WriteLn('< '+username+' is BACK');
  except
    label4.caption := 'NOT SENT';
  end;
  Timer6.Enabled := TRUE;
  Timer7.Enabled := FALSE;
end;

end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  IdTCPCLient1.Disconnect;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  IdTCPCLient1.Disconnect;
end;

end.

Source please.
I am very interested.
Since I phailed at this in C#.

From: Hermen
Source please.
I am very interested.
Since I phailed at this in C#.

sauce added :) Good Luck : D..

Also feel free to try out mine and leave some feedback.

You might want to add a note about the whole "will work when your internet is down" thing. I haven't looked at it or anything, but I assume that would require you to be on the same network as the person you're talking to, correct?

Name your variables, constants and object more organized, please do.
Mine worked on the network too…, but not on the webz.

From: senrath
You might want to add a note about the whole "will work when your internet is down" thing. I haven't looked at it or anything, but I assume that would require you to be on the same network as the person you're talking to, correct?

right :).. It can connect to anything where you can reach the ip ;)…
so.. Lan, Internet…

Name your variables, constants and object more organized, please do.
Mine worked on the network too…, but no on the webz.

Haha, i didnt ment to submit the source anyways… but feel free to ask for help if you need clarification on some parts : D…

~caused

From: caused
right :).. It can connect to anything where you can reach the ip ;)…
so.. Lan, Internet…



Haha, i didnt ment to submit the source anyways… but feel free to ask for help if you need clarification on some parts : D…

~caused

It is good to have your stuff organized so later you can read it.
I have despite from the fact I always was like button1, button2 etc. like you do now. I try ignoring it unless it's just a 1 minute project.

From: Hermen
It is good to have your stuff organized so later you can read it.

He said he wasn't planning on releasing the source, but did so only for your sake; yet it seems to me like you're not too satisfied, which is something you should be.

Sounds like a nice app, caused, thanks for sharing the source. I'll definitely take a look at it + source in about 30 mins. Wish I could've rep+'ed you, but I already did not too long ago.

From: EvilChicken!
He said he wasn't planning on releasing the source, but did so only for your sake; yet it seems to me like you're not too satisfied, which is something you should be.

Sounds like a nice app, caused, thanks for sharing the source. I'll definitely take a look at it + source in about 30 mins. Wish I could've rep+'ed you, but I already did not too long ago.

No matter if it's private or not you should try, to keep stuff organized that is the base of lots of stuff.

I was only giving him an advice so calm down.

From: Hermen
No matter if it's private or not you should try, to keep stuff organized that is the base of lots of stuff.

I was only giving him an advice so calm down.

First of all, I'm totally calm.

Second, I'm just insinuating that not everybody might share your opinion, and that every individual coder has different ways of approaching things.
It intrigued me that you, instead of showing appreciation, criticized his work.

I'm organizing stuff when working on projects with other people. Or writing Sauce for learning purposes.

Back to Topic :D

From: Hermen
Name your variables, constants and object more organized, please do.
Mine worked on the network too…, but not on the webz.

I told him to organize and gave him a compliment on his work.

From: Hermen
It is good to have your stuff organized so later you can read it.
I have despite from the fact I always was like button1, button2 etc. like you do now. I try ignoring it unless it's just a 1 minute project.

Someone commented on me so I reacted why I/You should organize.

From: Hermen
No matter if it's private or not you should try, to keep stuff organized that is the base of lots of stuff.

I was only giving him an advice so calm down.

Explained it again.

From: EvilChicken!
He said he wasn't planning on releasing the source, but did so only for your sake; yet it seems to me like you're not too satisfied, which is something you should be.

Sounds like a nice app, caused, thanks for sharing the source. I'll definitely take a look at it + source in about 30 mins. Wish I could've rep+'ed you, but I already did not too long ago.

You didn't read what I said I have made one type(not was no)

From: EvilChicken!
First of all, I'm totally calm.

Second, I'm just insinuating that not everybody might share your opinion, and that every individual coder has different ways of approaching things.
It intrigued me that you, instead of showing appreciation, criticized his work.

Again you say I criticize him, while I want to help him by giving him advice.

Again, good job mine didn't work on the internet.
You should organize, unless it is a one minute project.

Lots of :).