Home Explore Help
Sign In
pascal
/
freepascal.compiler
mirror of https://gitlab.com/freepascal.org/fpc/source.git
2
0
Fork 0
Files Issues 0 Wiki
Browse Source

* PChar -> PAnsiChar

Michaël Van Canneyt 2 years ago
parent
b32e940beb
commit
196ab9e12f
2 changed files with 108 additions and 16 deletions
Unified View Show Diff Stats
  1. 74 0
      packages/fcl-web/examples/echo/cgiapp/echo.lpr
  2. 34 16
      packages/fcl-web/src/base/cgiapp.pp

+ 74 - 0
packages/fcl-web/examples/echo/cgiapp/echo.lpr
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.
 
+

+ 34 - 16
packages/fcl-web/src/base/cgiapp.pp
View File 

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