Version:0.9 StartHTML:0000000105 EndHTML:0000051421 StartFragment:0000001037 EndFragment:0000051405
program Motion_HTTPServer_Arduino;
// first httpserver script & arduino control of webmax of internet series
// start after script loading with http://127.0.0.1/LED or http://127.0.0.1/DEL
// Send the command LED and DEL to shine on a LED on Arduino Board, locs=379
Const
BACKMAP = 'examples\images\bmp47.bmp';
SIG ='<--------->';
var
HTTPServer: TIdCustomHTTPServer;
ends: TOnSessionEndEvent;
cPort: TComPort;
procedure HTTPServerGet(aThr: TIdPeerThread; reqInfo: TIdHTTPRequestInfo;
respInfo: TIdHTTPResponseInfo);
var localcom: string;
ByteSent: Cardinal;
begin
RespInfo.ContentText:=
'<html><head><title>maXbox Web Connection Arduino</title></head><body><h1>Welcome to LED WebBox3</h1>'#13 +
'Check the script 305_webserver_arduino to discover more:<br><ul><li>Search for '#13 +
'<b>a LED</b> to <b>light it on the event OnCommandGet and the tag LED and DEL</b>!'+
'<br><b>LED is ON with /LED or OFF with /DEL</b> </ul></body></html>';
Writeln(Format('Command %s %s at %-10s received from %s:%d',[ReqInfo.Command, ReqInfo.Document,
DateTimeToStr(Now), aThr.Connection.socket.binding.PeerIP,
aThr.Connection.socket.binding.PeerPort]));
localcom:= ReqInfo.Document;
writeln(localcom)
if uppercase(localcom) = uppercase('/LED') then begin
cPort.WriteStr('1')
writeln(localcom+ ': LED on');
RespInfo.ContentText:=
'<html><head><title>maXbox Web Connection Arduino</title></head><body><h1>Welcome to LED WebBox3</h1>'#13 +
'Check the script 305_webserver_arduino to discover more:<br><ul><li>Search for '#13 +
'<b>a LED</b> to <b>light it on the event OnCommandGet and the tag LED and DEL</b>!'+
'<br><b>LED is: ON</b> </ul></body></html>';
end else
if uppercase(localcom) = uppercase('/DEL') then begin
cPort.WriteStr('A');
writeln(localcom+ ': LED off');
RespInfo.ContentText:=
'<html><head><title>maXbox Web Connection Arduino</title></head><body><h1>Welcome to LED WebBox3</h1>'#13 +
'Check the script 305_webserver_arduino to discover more:<br><ul><li>Search for '#13 +
'<b>a LED</b> to <b>light it on the event OnCommandGet and the tag LED and DEL</b>!'+
'<br><b>LED is: OFF</b> </ul></body></html>';
end
else begin
RespInfo.ResponseNo:= 404; //Not found
RespInfo.ContentText:=
'<html><head><title>Sorry WebBox Error</title></head><body><h1>' +
RespInfo.ResponseText + '</h1></body></html>';
end;
end;
procedure HTTPServerStartExecute(Sender: TObject);
begin
HTTPServer:= TIdCustomHTTPServer.Create(self)
with HTTPServer do begin
if Active then Free;
if not Active then begin
Bindings.Clear;
bindings.Add;
bindings.items[0].Port:= 80;
bindings.items[0].IP:= '127.0.0.1';//'192.168.1.53';
Active:= true;
onCommandGet:= @HTTPServerGet;
Writeln(format('Listening for HTTP on %s:%d.',
[Bindings[0].IP, Bindings[0].Port]));
end;
//Showmessage('Close OK to HTTP Server');
//HTTPServer.Free;
end;
end;
//*******************************COM Port Arduino*****************************//
var
chk_led1, chk_led2, chk_led3, chk_led4: TCheckBox;
btn_connect, btn_Setup, btn_loop: TBitBtn;
statBar: TStatusBar;
comFrm: TForm;
procedure LED_Checker(ab: boolean; checker: boolean);
begin
if checker then begin
chk_led1.Checked:= ab;
chk_led2.Checked:= ab;
chk_led3.Checked:= ab;
chk_led4.Checked:= ab;
end else begin
chk_led1.Enabled:= ab;
chk_led2.Enabled:= ab;
chk_led3.Enabled:= ab;
chk_led4.Enabled:= ab;
end;
end;
procedure TForm1_btn_connectClick(Sender: TObject);
begin
if cPort.Connected then begin
btn_connect.Caption:= 'Connect'; // Toggle the caption of Connection Button !
btn_Setup.Enabled:= True; // If not connected, lets enable the Setup Button
btn_loop.Enabled:= false; // Knight Rider demo button is disabled at first
// This block resets the state of all Leds to Off
// According to Arduino Code the Chars A,B,C,D,E are used
// to set Digital Pins (2-6) to LOW
with cPort do begin
WriteStr('A');
WriteStr('B');
WriteStr('C');
WriteStr('D');
end;
// This block resets the state of all Check Boxes to Unchecked
LED_Checker(false, true);
cPort.Close; // COM Port in use is closed
statBar.Panels[1].Text:='Disconnected';
LED_Checker(false, false); //enabler
end else begin
btn_connect.Caption:='Disconnect'; // Toggle the caption of Connection Button
btn_Setup.Enabled:=False; // If not connected, lets disable Setup Button
btn_loop.Enabled:=true; // Now that conection Rider demo button is enabled
cPort.Open; // COM Port in use is finally opened
statBar.Panels[1].Text:='Connected';
// This block enables the check boxes
// so the user can change them to set LED states when COM Port is connected
LED_Checker(true, false);
end
end;
procedure TForm1_btn_SetupClick(Sender: TObject);
begin
cPort.ShowSetupDialog; // Opens the predefined Setup Dialog (part of ComPort component)
statBar.Panels[0].Text:= 'Port in use ' + cPort.Port; // Status is set to display Port in use after setup dialog
end;
procedure TForm1_FormCreateCom(Sender: TObject);
begin
cPort:= TComPort.Create(self);
with cPort do begin
BaudRate:= br9600;
Port:= 'COM5';
Parity.Bits:= prNone;
StopBits:= sbOneStopBit;
DataBits:= dbEight;
{FlowControl.OutCTSFlow:= False;
FlowControl.OutDSRFlow:= False;
FlowControl.ControlDTR:= dtrDisable;
FlowControl.ControlRTS:= rtsDisable;
FlowControl.XonXoffOut:= False;
FlowControl.XonXoffIn:= False;}
end;
statBar.Panels[0].Text:='Port in use '+ cPort.Port; //show predefined Port in use at begining of program execution
if cPort.Connected=true then
statBar.Panels[1].Text:= 'Connected'
else
statBar.Panels[1].Text:= 'Disconnected'
end;
// Next are the procedures to turning ON and OFF each led using the variables
// defined on both Arduino code and Delphi code.
// Sending the predifined vars thru serial comm (on byte at the time)
// Ports 2,3,4,5,6 are turned ON by sending it corresponding var 1,2,3,4,5
// and they are turned OFF by sending it corresponding var A,B,C,D,E
procedure chk_led1Click(Sender: TObject);
begin
if chk_led1.Checked=true then
cPort.WriteStr('1')
else
cPort.WriteStr('A');
writeln('debug: com led 1 signal');
end;
procedure chk_led2Click(Sender: TObject);
begin
if chk_led2.Checked=true then
cPort.WriteStr('2')
else cPort.WriteStr('B')
end;
procedure chk_led3Click(Sender: TObject);
begin
if chk_led3.Checked=true then
cPort.WriteStr('3')
else cPort.WriteStr('C')
end;
procedure chk_led4Click(Sender: TObject);
begin
if chk_led4.Checked=true then
cPort.WriteStr('4')
else cPort.WriteStr('D')
end;
// Here ends the ON/OFF procedures for each LED
procedure TForm1_FormClose(Sender: TObject; var Action: TCloseAction);
begin
if cPort.Connected then begin
cPort.WriteStr('A'); // If the application is closed, its good to leave
cPort.WriteStr('B'); // everything as we found it at start.
cPort.WriteStr('C'); // So we reset all the leds to OFF
cPort.WriteStr('D');
cPort.Close;
end;
HTTPServer.Free;
Writeln('Server Stopped at '+DateTimeToInternetStr(Now, true))
end;
procedure TForm1_btn_loopClick2(Sender: TObject);
var i: byte;
begin
// We turn off all Led Check Boxes to allow a clean state before and after Knight Rider mode
LED_Checker(false, true);
// Here begins the rough mode of Knight Rider Demo ;)
try
with cPort do begin
for i:= 1 to 5 do begin
WriteStr('1'); Sleep(50);
WriteStr('A'); Sleep(50);
WriteStr('1'); Sleep(150);
WriteStr('A'); Sleep(150);
WriteStr('1'); Sleep(450);
WriteStr('A'); Sleep(250);
WriteStr('1'); Sleep(150);
WriteStr('A'); Sleep(150);
WriteStr('1'); Sleep(50);
WriteStr('A'); Sleep(1000);
end;
end;
except
Showmessage('comport not in use - connect first');
end;
end;
Procedure LabelFactory(a,b,c,d: byte; title: shortstring);
begin
with TLabel.create(self) do begin
parent:= comfrm;
SetBounds(a,b,c,d);
Caption:= title
end;
end;
Procedure CheckBoxFactory(a,b,c,d: byte; title: shortstring;
abox: TCheckbox; anevent: TNotifyEvent);
begin
with abox do begin
parent:= comfrm;
SetBounds(a,b,c,d)
Caption:= title;
Enabled:= False;
//OnClick:= anevent;
end;
end;
Procedure BtnFactory(a,b,c,d: smallint; title: shortstring; apic: shortstring;
abtn: TBitBtn; anevent: TNotifyEvent);
begin
with abtn do begin
parent:= comfrm;
setbounds(a,b,c,d)
font.size:= 12;
glyph.LoadFromResourceName(HINSTANCE, apic); //Knownfile
mXButton(05,05,width, height,12,12,handle);
caption:= title;
//onClick:= anevent;
end;
end;
//******************************* Form Build********************************
procedure InitComPortForm;
begin
comFrm:= TForm.create(self);
with comFrm do begin
//FormStyle := fsStayOnTop;
Position:= poScreenCenter;
caption:='COM Port meets Arduino LED - DblClick to Save Outline';
//color:= clsilver;
width:= 700; height:= 550;
//onCreate:= @TForm1_FormCreate;
onClose:= @TForm1_FormClose;
Show;
canvas.brush.bitmap:= getBitmapObject(Exepath+'examples\images\bmp47.bmp');
Canvas.FillRect(Rect(600,400,210,100));
end;
btn_Setup:= TBitBtn.create(comfrm); //Constructors
btn_Loop:= TBitBtn.create(comfrm);
btn_connect:= TBitBtn.create(comfrm);
btn_connect.onClick:= @TForm1_btn_connectClick;
BtnFactory(180,440,150,55, 'C&onnect Node','CL_MPNEXT',btn_connect, NIL);
btn_loop.onClick:= @TForm1_btn_loopClick2;
BtnFactory(340,440,150,55, '&Knight Rider','CL_MPPLAY',btn_loop, NIL);
btn_Setup.onClick:= @TForm1_btn_SetupClick;
BtnFactory(500,440,150,55, '&COM Settings','LEDbulbon',btn_Setup, NIL);
chk_led1:= TCheckBox.create(self)
chk_led1.OnClick:= @chk_led1Click;
CheckBoxFactory(16,42,57,17, 'Led 1',chk_led1,NIL);
chk_led2:= TCheckBox.create(self)
chk_led2.OnClick:= @chk_led2Click;
CheckBoxFactory(16,66,57,17, 'Led 2',chk_led2,NIL);
chk_led3:= TCheckBox.create(self)
chk_led3.OnClick:= @chk_led3Click;
CheckBoxFactory(16,90,57,17, 'Led 3',chk_led3,NIL);
chk_led4:= TCheckBox.create(self)
chk_led4.OnClick:= @chk_led4Click;
CheckBoxFactory(16,114,57,17, 'Led 4',chk_led4,NIL);
with TLabel.create(self) do begin
parent:= comfrm;
setBounds(16,12,69,13)
Caption:= 'LED Control';
Font.Charset:= DEFAULT_CHARSET;
Font.Color:= clMaroon;
Font.Size:= 13;
Font.Name:= 'MS Sans Serif';
Font.Style:= [fsBold];
end;
with TLabel.create(self) do begin
parent:= comfrm;
setBounds(155,12,69,13)
Caption:= 'Arduino PIN';
Font.Charset:= DEFAULT_CHARSET;
Font.Color:= clNavy;
Font.Size:= 13;
Font.Name:= 'MS Sans Serif';
Font.Style:= [fsBold];
end;
LabelFactory(80,42,39,13, SIG)
LabelFactory(80,66,39,13, SIG)
LabelFactory(80,90,39,13, SIG)
LabelFactory(80,114,39,13, SIG)
LabelFactory(156,42,38,13, 'Digital 2')
LabelFactory(156,66,38,13, 'Digital 3')
LabelFactory(156,90,38,13, 'Digital 4')
LabelFactory(156,114,38,13, 'Digital 5')
with TDateTimePicker.Create(self) do begin
parent:= comfrm;
date;
top:= 190; left:= 15;
calAlignment:= albottom;
end;
statBar:= TStatusBar.create(self);
with statBar do begin
parent:= comFrm;
Panels.add;
panels.items[0].width:= 200;
panels.items[0].text:= '200';
Panels.add;
panels.items[1].width:= 150;
panels.items[1].text:= '150';
end;
TForm1_FormCreateCom(self);
end; //******************************End Form Build************************
begin //main server App
writeln('machine IP: '+GetIpAddress(getHostName))
writeln('Thread ID :'+intToStr(CurrentThreadID))
writeln('Process ID :'+intToStr(CurrentProcessID))
writeln('machine name is: '+getHostName)
writeln('user name is: '+getUserName)
InitComPortForm;
HTTPServerStartExecute(self);
Writeln('Server Started at '+DateTimeToInternetStr(Now, true))
//GetTimeZoneInformation
End.
//***********************************Code Snippets******************
(*procedure AccessDenied;
begin
ResponseInfo.ContentText:=
'<html><head><title>Error</title></head><body><h1>Access denied</h1>'#13 +
'You do not have sufficient priviligies to access this document.</body></html>';
ResponseInfo.ResponseNo:= 403;
end;*)
(*procedure AuthFailed;
begin
ResponseInfo.ContentText:=
'<html><head><title>Error</title></head><body><h1>Authentication failed</h1>'#13 +
'Check the file ip_a.ini to discover the demo password:<br><ul><li>Search for '#13 +
'<b>AuthUsername</b> in <b>maXboxMain.pas</b>!</ul></body></html>';
ResponseInfo.AuthRealm:= CAUTHENTICATIONREALM; *)
(*if not HTTPServer.Active then begin
HTTPServer.Bindings.Clear;
Binding := HTTPServer.Bindings.Add;
Binding.Port := StrToIntDef(edPort.text, 80);
Binding.IP := '127.0.0.1';
end;*)
//statusbar1.SimpleText:= 'http active on v1.9';
//+ [IdServerInterceptOpenSSL.SSLOptions.Method]
//DisplayMessage(Format('OpenSSLVersion is: %s', [getOpenSSLVersion]))
Port Not Open.Fault : Port Not Open. Date/time : 30.09.2012 17:53:52 Stack dump ---------- 0055632D 00556DB4 00556EFF 00556F71 0010EA73 0010FA01 0001A20A 00103D2F 000024DA 000055C5 00005608 000056E5 000FF62D 00101499 00111208 0070F174 00109E7E 0000BC4C 00108D45 00004489 00113E79 00113923 0046A014 0046A7B7 0046A90C 00308923 002228ED 0022293E 0022295B 00222985 0003644F 00005466 Fault : Port Not Open.Fault : Port Not Open. Date/time : 30.09.2012 17:53:52 Stack dump ---------- 0055632D 00556DB4 00556EFF 00556F71 0010EA73 0010FA01 0001A20A 00103D2F 000024DA 000055C5 00005608 000056E5 000FF62D 00101499 00111208 0070F174 00109E7E 0000BC4C 00108D45 00004489 00113E79 00113923 0046A014 0046A7B7 0046A90C 00308923 002228ED 0022293E 0022295B 00222985 0003644F 00005466 Date/time : 30.09.2012 17:53:52 Stack dump