SCAR Code:
program New;
var
Client, StartPoint: integer;
frmDesign: TForm;
SendButton, LogIn: TButton;
MessageBar, UserName, Password: TEdit;
MessageBox: TMemo;
LUserName, LPassword: TLabel;
HideBox: TPanel;
RefreshMessages: TTimer;
User, Messages: string;
BackgroundCanvas: TCanvas;
function ReadFile: string;
begin
Result:= GetHTTPPage(Client, 'http://myspacefaking.freehostia.com/Messages.txt');
end;
procedure SendMessage(Msg: string);
var
Text: string;
begin
if Msg = 'clear' then
begin
AddPostVariable(Client, 'text', Msg);
StartPoint:= 1;
end else
AddPostVariable(Client, 'text', User + ': ' + Msg + #13 + #10);
PostHTTPPageEx(Client, 'http://myspacefaking.freehostia.com/MessageHandler.php');
Text:= ReadFile;
MessageBox.Text:= Copy(Text, StartPoint, Length(Text));
end;
procedure ButtonClick(Sender: TObject);
begin
SendMessage(MessageBar.Text);
MessageBar.Text:= '';
end;
procedure LoginClick(Sender: TObject);
var
Text: string;
begin
{if Password.Text <> 'skate' then
begin
GetApplication.MessageBox('Invalid password.', 'Error:', 0);
Exit;
end; }
User:= UserName.Text;
LUserName.Visible:= false;
LPassword.Visible:= false;
UserName.Visible:= false;
Password.Visible:= false;
Login.Visible:= false;
frmDesign.Width:= 807;
frmDesign.Height:= 604;
frmDesign.BorderStyle:= bsSizeable;
frmDesign.Left:= 0;
frmDesign.Top:= 0;
frmdesign.Caption:= 'Google';
frmDesign.Color:= ClWhite;
SendButton.Visible:= true;
MessageBar.Visible:= true;
MessageBox.Visible:= true;
CopyCanvas(BackgroundCanvas, frmDesign.Canvas, 0, 0, 800, 800, 0, 0, 800, 800);
AddPostVariable(Client, 'text', User + ' has logged in.' + #13 + #10);
PostHTTPPageEx(Client, 'http://myspacefaking.freehostia.com/MessageHandler.php');
Text:= ReadFile;
MessageBox.Text:= 'Welcom to Message Sender, ' + User +
#13 + #10 + Copy(Text, StartPoint, Length(Text));
RefreshMessages.Interval:= 3000;
RefreshMessages.Enabled:= true;
end;
procedure Hide(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
frmDesign.Visible:= false;
GetSelf.Visible:= false;
IsFKeyDown(5);
IsFKeyDown(5);
repeat
Wait(500);
until(IsFKeyDown(5));
GetSelf.Visible:= true;
frmDesign.Visible:= true;
CopyCanvas(BackgroundCanvas, frmDesign.Canvas, 0, 0, 800, 800, 0, 0, 800, 800);
end;
function Occurences(FindText, Text: string): integer;
var
i, a: integer;
begin
repeat
a:= PosEx(FindText, Text, i + 1);
if (a > Length(Text)) or (a < 1) then
Break;
i:= PosEx(FindText, Text, i + 1);
Inc(Result);
until(false);
end;
procedure Refresh(Sender: TObject);
var
TempMessages: string;
begin
if RefreshMessages.Interval = 3000 then
RefreshMessages.Interval:= 1000;
TempMessages:= GetHTTPPage(Client, 'http://myspacefaking.freehostia.com/Messages.txt');
if (Occurences(#13, Copy(TempMessages, StartPoint, Length(TempMessages))) > 16) then
StartPoint:= StartPoint + Pos(#13, Messages);
if (TempMessages <> Messages) then
begin
Messages:= TempMessages;
if Length(Messages) < 1 then
StartPoint:= 1;
MessageBox.Text:= Copy(Messages, StartPoint, Length(Messages));
end;
CopyCanvas(BackgroundCanvas, frmDesign.Canvas, 0, 0, 800, 800, 0, 0, 800, 800);
end;
procedure InitForm;
begin
frmDesign := CreateForm;
frmDesign.Caption := 'Message Sender';
frmDesign.Color := RGBToColor(0, 255, 0);
frmDesign.Font.Color := clWindowText;
frmDesign.Font.Height := -11;
frmDesign.Font.Name := 'MS Sans Serif';
frmDesign.Font.Style := [];
frmDesign.Visible := False;
frmDesign.PixelsPerInch := 96;
frmDesign.Width:= 203;
frmDesign.Height:= 137;
frmDesign.BorderStyle:= bsDialog;
frmDesign.Position:= poScreenCenter;
SendButton:= TButton.Create(frmDesign);
with SendButton do
begin
Left:= 430;
Top:= 113;
Caption:= 'Search';
Visible:= false;
Parent:= frmDesign;
OnClick:= @ButtonClick;
end;
MessageBar:= TEdit.Create(frmDesign);
with MessageBar do
begin
Left:= 165;
Top:= 115;
Width:= 260;
Visible:= false;
Parent:= frmDesign;
end;
MessageBox:= TMemo.Create(frmDesign);
with MessageBox do
begin
Left:= -1;
Top:= 246;
Width:= 544;
Height:= 306;
Visible:= false;
Parent:= frmDesign;
Font.Color:= 13369344;
Font.Name:= 'arial';
Font.Size:= 11;
Color:= clWhite;
ReadOnly:= true;
Cursor:= crArrow;
end;
UserName:= TEdit.Create(frmDesign);
with UserName do
begin
Left:= 85;
Top:= 10;
Width:= 100;
Visible:= true;
Parent:= frmDesign;
end;
Password:= TEdit.Create(frmDesign);
with Password do
begin
Left:= 85;
Top:= 40;
Width:= 100;
Visible:= true;
Parent:= frmDesign;
PasswordChar:= '*';
end;
LUserName:= TLabel.Create(frmDesign);
with LUserName do
begin
Left:= 10;
Top:= 10;
Width:= 100;
Visible:= true;
Parent:= frmDesign;
Caption:= 'Username';
with Font do
begin
Color:= clRed;
Size:= 11;
Name:= 'arial bold';
end;
end;
LPassword:= TLabel.Create(frmDesign);
with LPassword do
begin
Left:= 10;
Top:= 40;
Width:= 100;
Visible:= true;
Parent:= frmDesign;
Caption:= 'Password';
with Font do
begin
Color:= clRed;
Size:= 11;
Name:= 'arial bold';
end;
end;
Login:= TButton.Create(frmDesign);
with Login do
begin
Left:= 60;
Top:= 70;
Visible:= true;
Parent:= frmDesign;
Caption:= 'Log In';
OnClick:= @LoginClick;
end;
HideBox:= TPanel.Create(frmDesign);
with HideBox do
begin
Left:= 600;
Top:= 90;
Width:= 183;
Height:= 71;
Visible:= true;
Parent:= frmDesign;
OnMouseMove:= @Hide;
end;
RefreshMessages:= TTimer.Create(frmDesign);
with RefreshMessages do
begin
Enabled:= false;
OnTimer:= @Refresh;
end;
end;
procedure SafeInitForm;
var
v: TVariantArray;
begin
SetArrayLength(v, 0);
ThreadSafeCall('InitForm', v);
end;
procedure ShowFormModal;
begin
frmDesign.ShowModal;
end;
procedure SafeShowFormModal;
var
v: TVariantArray;
begin
SetArrayLength(v, 0);
ThreadSafeCall('ShowFormModal', v);
end;
begin
try
Client:= InitializeHTTPClient(True, True);
BackgroundCanvas:= GetBitmapCanvas(BitmapFromString(800, 800, ''));
StartPoint:= Length(GetPage('http://myspacefaking.freehostia.com/Messages.txt'));
SafeInitForm;
SafeShowFormModal;
finally
FreeForm(frmDesign);
FreeBitmap(0);
except
RaiseException(ErCustomError, 'There was an error in the form');
end;
end.