Http avec iziBasic et PP
Thursday 26 October 2006 - 11:27:59
Malgres mes divers développement sur pp, je n'ai pas oublié le premier compilateur qui m'a permit d'apprendre progressivement la programmation sur Palm. Et aujourd'hui je vous presente une applet permettant de faire des requettes http depuis iziBasic.
Requis

- PPShell
- pp.exe pour ARM
- iziBasic
- Savoir compiler avec PP
- Savoir compiler avec iziBasic

L'applet PP (Pascal)
Deux choix sont possible :

- Recuperer le resultat de la requête directement dans la string que retourne l'applet pp. Donc limité à 64 caractères, ce qui est plutôt contraignant.
- Stocker le résultat de la requête dans un fichier pour être lu au complet depuis un code source iziBasic.

Nous allons voir la seconde solution.
Voici le code source de l'applet pp.
`
program iBHttpPP;
//
type iBasFunType=function(S:string):string;
var iBasCallPP:iBasFunType;
const
MAXMEGASTRING=16376;
//PP limits arrays to 32 k ... this one is one of the biggest you can create
// soit MAXMEGASTRING=32752;
type
u_char=UInt8;
u_short=UInt16;
u_int=UInt16;
u_long=UInt32;
size_t=UInt32;
MegaStringPtr = ^MegaStringType;
MegaStringType = Array[0..MAXMEGASTRING] of char;
const
SOCK_STREAM=netSocketTypeStream;
SOCK_DGRAM=netSocketTypeDatagram;
SOCK_RAW=netSocketTypeRaw;
SOCK_RDM=netSocketTypeReliableMsg;
AF_INET=netSocketAddrINET;
AF_RAW=netSocketAddrRaw;
type
sockaddr=record
sa_family: Int16;
sa_data: array[1..14] of UInt8;
end;
in_addr=record
case integer of
1:( s_net, s_host, s_lh, s_impno: UInt8; );
2:( s_W1, s_imp: UInt16; );
3:( s_addr: UInt32 );
end;
sockaddr_in=record
sin_family: Int16;
sin_port: u_short;
sin_addr: in_addr;
sin_zero: array[1..8] of char;
end;
/////////////////////////////////////
// StringToRessourceLab
/////////////////////////////////////
function StringToRessourceLab(const sMyString:string):integer;
begin
StringToRessourceLab:=
Ord(sMyString[4])+
256*Ord(sMyString[3])+
65536*Ord(sMyString[2])+
16777216*Ord(sMyString[1]);
end;
/////////////////////////////////////
// charcpy
// procedure pour copier une chaine
// dans la mega chaine
/////////////////////////////////////
procedure charcpy(var index:UInt16;c:MegaStringPtr;s:String);
var
i:UInt32;
begin
i:=1;
while (s[i]<>chr(0)) and (index
c^[index]:=s[i];
index:=index+1;
i:=i+1;
end;
if index>MAXMEGASTRING then
index:=MAXMEGASTRING;
end;
/////////////////////////////////////
// CreateDb
// Fonction pour creer une base de données palm
/////////////////////////////////////
Function CreateDb(resName,resCreator,rType:string):Err;
var
CardNumber:integer;
DBErr:Err;
libCreatorID:Uint32;
IDDataBase:LocalID;
Begin
CardNumber:=0;
IDDataBase:=DmFindDatabase(0,resName);
if (IDDataBase=0) then
DBErr := DmCreateDatabase(CardNumber, resName,StringToRessourceLab(resCreator),StringToRessourceLab(rType), false);
CreateDb:=DBErr;
end;
/////////////////////////////////////
// DelDb
// Fonction pour effacer une base de données palm
/////////////////////////////////////
Procedure DelDb(resName:string);
var
CardNumber:integer;
DBErr:Err;
IDDataBase:localID;
Begin
CardNumber:=0;
IDDataBase:=DmFindDatabase(0,resName);
if (IDDataBase>0) then
DBErr := DmDeleteDatabase(CardNumber, IDDataBase);
end;
/////////////////////////////////////
// WriteHTTP
// Fonction pour ecrire la mega chaine
// Dans une base de données palm
/////////////////////////////////////
procedure WriteHTTP(fichier:String;s:MegaStringPtr;size:UInt32);
var
h:Memhandle;
pp:Pointer;
u:UInt16;
e:Err;
gDataBase:DmOpenRef;
IDDataBase:LocalID;
begin
IDDataBase:=DmFindDatabase(0,fichier);
if (IDDataBase<>0) then Begin
gDataBase:=DmOpenDatabase(0,IDDataBase,dmModeReadWrite);
if (gDataBase<>nil) then begin
if DmNumRecords(gDataBase)<65000 then begin
u:=0; // new record
h:=DmNewRecord(gDataBase,u,size);
if h<>nil then begin
pp:=MemHandleLock(h);
if pp <> nil then begin
DmWrite(pp,0,s,size);
DmReleaseRecord(gDataBase,u,true);
MemHandleUnlock(h); // PG 22022004
end;
end;
end;
DmCloseDatabase(gDataBase);
end;
end;
end;
/////////////////////////////////////
// getbyname
// The main function of the applet.
// Ici nous allons construire la requette http
// l envoyer, et ecrire le resultat dans une
// base de données palm
/////////////////////////////////////
function getbyname(fichier:string;domain:string;page:String;port:UInt16):String;
var
size,received:UInt16;
refsocket:NetSocketRef;
address:NetSocketAddrType;
address_in:NetSocketAddrINType;
address_inaddrPtr:Pointer;
host:NetHostInfoBufType;
requetehttp:MegaStringPtr;
indexrequetehttp:UInt16;
endline:string;
libRef:UInt16;
error:UInt16;
erreur:Err;
y,nb:UInt16;
AppNetTimeout: Int32;
AppNetRefnum: UInt16;
sent:UInt16;
saved:WinHandle;
begin
AppNetRefnum:=0;
error:=0;
//Recherche de la netlib
SysLibFind('Net.lib',AppNetRefnum);
//Set timeout
AppNetTimeout:=30*100;
//Init of the megastring buffer
requetehttp:=MemPtrNew(sizeof(char)*MAXMEGASTRING);
//Test if buffer is correctly initializing.
if requetehttp=nil then begin
error:=1;
getbyname:='Error in memory allocating ...';
end;
//Si le buffer est bien initialise alors nous attaquons
if error=0 then begin
//Opening netlib
erreur:=NetLibOpen(AppNetRefnum,error);//,error);
//If it s ok ... so
if (error=0) or (error=$1201) then begin
//We ask the ip of the hostname to the dns.
NetLibGetHostByName(AppNetRefnum, domain,@host,AppNetTimeout,error);
//We forge the socket
refsocket:=NetLibSocketOpen(AppNetRefnum,netSocketAddrINET,netSocketTypeStream,6,AppNetTimeout,error);
if refsocket<>0 then begin
address_in.addr:=host.address[0];
address_in.family:= 2;
address_in.port:=port;
//Connecting socket
error:=NetLibSocketConnect(AppNetRefnum,refsocket,@address_in,sizeof(address_in),AppNetTimeout,erreur);
if erreur=0 then begin
//Forge de la requete http
endline:=CHR(13)+CHR(10);
indexrequetehttp:=0;
charcpy(indexrequetehttp,requetehttp,'GET '+page);
charcpy(indexrequetehttp,requetehttp,' HTTP/1.1'+endline+'host: '+domain+endline);
charcpy(indexrequetehttp,requetehttp,'Connection: close'+endline);
charcpy(indexrequetehttp,requetehttp,'User-Agent: Palm'+endline);
charcpy(indexrequetehttp,requetehttp,endline);
//We send the request until all is sent or an error occur
sent:=0;
error:=1;
while (sent0) and (erreur=0) do begin
error:=NetLibSend(AppNetRefnum,refsocket,@requetehttp^[sent],indexrequetehttp-sent,0,nil,0,AppNetTimeout,erreur);
sent:=sent+error;
end;
//if nothing is sent then error occurs
if sent<=0 then getbyname:='Error while sending...';
//We read answer in the netlib buffer until the buffer is clear
error:=1;
erreur:=0;
sent:=0;
while (error>0) and ((MAXMEGASTRING-sent)>1) and (erreur=0) do begin
error:=NetLibReceive(AppNetRefnum,refsocket,@requetehttp^[sent],(MAXMEGASTRING-sent),0,nil,nil,AppNetTimeout,erreur);
sent:=sent+error;
end;
//We del the file
DelDb(fichier);
//We create a new palm database
CreateDb(fichier,('Khrt'),('http'));
//We write the result of the request
WriteHTTP(fichier,requetehttp,sent);
end else begin
getbyname:='Can t open socket';
end;
NetLibSocketClose(AppNetRefnum, refsocket,AppNetTimeout,erreur);
end else begin
getbyname:='Can t create socket';
end;
NetLibClose(AppNetRefnum,0);
end else begin
getbyname:='Can t open netlib';
end;
end;
MemPtrFree(requetehttp);
end;
//Fonction appele par iziBasic lors d un CallPP
function CallPP(S:string):string;
var
url,fichier,domain,page,port:String;
i,u:UInt16;
begin
url:='';
fichier:='';
domain:='';
page:='';
port:='';
i:=1;
u:=0;
//Tokenize of the iziBasic call parameter string
// le fichier
// le domaine
// la page
// le port
while (S[i]<>CHR(0)) and (i<=64) do begin
if (S[i]<>CHR(10)) then begin
case u of
0: begin fichier:=fichier+S[i]; end;
1: begin url:=url+S[i]; end;
2: begin port:=port+S[i]; end;
end;
end else begin
u:=u+1;
end;
i:=i+1;
end;
i:=1;
u:=0;
while (url[i]<>CHR(0)) and (i<=64) do begin
if (url[i]<>'/') then begin
if u=0 then begin
domain:=domain+url[i];
end else begin
page:=page+url[i];
end;
end else begin
u:=1;
page:=page+url[i];
end;
i:=i+1;
end;
CallPP:=getbyname(fichier,domain,page,StrAToI(port));
// CallPP:=port;
end;
begin
iBasCallPP:=CallPP;
end.
`
Donc rien de bien compliqué, seulement un accés à une api que l'on a pas sous iziBasic, à savoir la NetLib.
Le code iziBasic
Je vais maintenant vous montrer comment utiliser notre applet PP avec izibasic.
`
' iBHttpPP.ibas
BEGIN
LABEL #1,"Fichier : TESTHTTP",2,30
LABEL #2,"URL : khertan.net/index.php",2,40
LABEL #3,"Port : 80",2,50
REM The parameter string
REM The file (here : TESTHTTP)
REM CHR$(10)
REM URL (here : khertan.net/index.php)
REM CHR$(10)
REM The port : (here : 80)
R$="TESTHTTP"+CHR$(10)+"khertan.net/index.php"+CHR$(10)+"80"
A$=CALLPP$(100,R$)
A=FILEERROR
IF A=0 THEN
A$="PP Code replied: '"+A$+"'"
ELSE
A$="PP Code was not found!"
ENDIF
LABEL #4,A$,2,80
REPEAT : A=DOEVENTS : UNTIL A=-1
END
`
Conclusion
Tout est possible à présent ...
Khertan.net by Benoit HERVIER Alias Khertan.