paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 18:21:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

* PChar -> PAnsiChar

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-01-24 09:41:05 +01:00
parent b32e940beb
commit 196ab9e12f
2 changed files with 108 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
packages/fcl-web/examples/echo/cgiapp/echo.lpr Normal file
View File

@ -0,0 +1,74 @@
program echo;
uses classes,sysutils,cgiapp;
Type
{ TMyCgiApplication }
TMyCgiApplication = Class(TCGIApplication)
Public
procedure DoRun; override;
end;
{ TMyCgiApplication }
procedure TMyCgiApplication.DoRun;
procedure AddRow(const aName,avalue : string);
begin
AddResponseLn(Format('<tr><td><b>%s</b></td><td>%s</td></tr>',[aName,aValue]));
end;
Var
L : TStrings;
V,N : String;
I : Integer;
begin
Terminate;
EmitContentType;
AddResponseLn('<html>');
AddResponseLn('<body>');
AddResponseLn('<h1>Simple CGI HTML echo demo</h1>');
AddResponseLn('<h2>Request variables</h2>');
AddResponseLn('<table border=1>');
AddRow('Variable','Value');
L:=TStringList.Create;
Try
GetRequestVarList(L);
For I:=0 to L.Count-1 do
begin
L.GetNameValue(I,N,V);
AddRow(N,V);
end;
AddResponseLn('</table>');
AddResponseLn('<h2>CGI variables</h2>');
AddResponseLn('<table border=1>');
AddRow('Variable','Value');
L.Clear;
GetCGIVarList(L);
For I:=0 to L.Count-1 do
begin
L.GetNameValue(I,N,V);
AddRow(N,V);
end;
AddResponseLn('</table>');
AddResponseLn('</body>');
AddResponseLn('</html>');
finally
L.Free;
end;
end;
begin
With TMyCgiApplication.Create(Nil) do
try
Initialize;
Run;
finally
Free
end;
end.

50
packages/fcl-web/src/base/cgiapp.pp
View File

@ -21,6 +21,9 @@ unit cgiapp;
Interface
uses
{$ifdef unix}
cwstring,
{$endif}
CustApp,Classes, SysUtils, httpdefs;
Const
@ -353,7 +356,7 @@ begin
S:=ContentType;
If (S='') then
S:='text/html';
AddResponseLn('Content-Type: '+ContentType);
AddResponseLn('Content-Type: '+S);
AddResponseLn('');
FContentTypeEmitted:=True;
end;
@ -512,10 +515,8 @@ Procedure TFormItem.Process;
Var
Line : String;
Words : TStringList;
i,len : integer;
c : char;
len : integer;
S : string;
quoted : boolean;
begin
Line:=GetLine(Data);
@ -545,12 +546,12 @@ begin
Data:=Copy(Data,1,Len-2);
end;
Function MakeString(PStart,PEnd : Pchar) : String;
Function MakeString(PStart,PEnd : PChar) : String;
begin
SetLength(Result,PEnd-PStart);
If Length(Result)>0 then
Move(PStart^,Result[1],Length(Result));
Move(PStart^,Result[1],Length(Result)*sizeof(Char));
end;
procedure FormSplit(var Cnt : String; const boundary: String; List : TList);
@ -725,7 +726,7 @@ var
aLenStr : Integer;
aLenSep : Integer;
function hexConverter(h1, h2 : Char) : Char;
function hexConverter(h1, h2 : AnsiChar) : AnsiChar;
var
B : Byte;
@ -740,20 +741,31 @@ var
var
index : Integer;
S : AnsiString;
begin
Index:=Length(QueryItem);
{$IF SIZEOF(CHAR)=2}
S:=UTF8Encode(QueryItem);
{$ELSE}
S:=QueryItem;
{$ENDIF}
Index:=Length(S);
While (Index>0) do
begin
If QueryItem[Index]='+' then
QueryItem[Index]:=' '
else If (QueryItem[Index]='%') and (Index<Length(QueryItem)-1) then
If S[Index]='+' then
S[Index]:=' '
else If (S[Index]='%') and (Index<Length(S)-1) then
begin
QueryItem[Index]:=hexConverter(QueryItem[Index+1],QueryItem[index+2]);
System.Delete(QueryItem,Index+1,2);
S[Index]:=hexConverter(S[Index+1],S[index+2]);
System.Delete(S,Index+1,2);
end;
dec(Index);
Dec(Index);
end;
{$IF SIZEOF(CHAR)=2}
QueryItem:=UTF8Decode(S);
{$ELSE}
QueryItem:=S;
{$ENDIF}
end;
procedure InitToken(aStr, aSep : String);
@ -859,11 +871,17 @@ Procedure TCGIApplication.AddResponse(Const S : String);
Var
L : Integer;
aLine : AnsiString {$IF SIZEOF(CHAR)=1} absolute S{$endif};
begin
L:=Length(S);
{$IF SIZEOF(CHAR)=2}
aLine:=UTF8Encode(S);
{$ENDIF}
L:=Length(aLine);
// Writeln(S,'- >',aLine,' (',L,')');
If L>0 then
FResponse.Write(S[1],L);
FResponse.Write(aLine[1],Length(aLine));
end;
Procedure TCGIApplication.AddResponse(Const Fmt : String; Args : Array of const);