-------- Original Message --------
Subject: [PSP-DEVEL] help me solve read/ln feature of webtext
Date: Mon, 15 Jan 2007 18:30:12 +0700
From: Bisma Jayadi <[EMAIL PROTECTED]>
Reply-To: [EMAIL PROTECTED]
Organization: UPPTI Unibraw
To: Milis PSP <[EMAIL PROTECTED]>
Hi all,
I'm getting close to complete write/ln and read/ln text driver for web utilizing
PWU. Basic functions have been done. Splitting process (asking for input and
getting the value) has solved easily because they are already seperated on the
driver. But there is still one problem left. I've been trying to solve this
almost all the day long, but I got no clues.
The complete webtext.pas unit is attached. This version has been reduced, I've
removed any unnecessary procedures/functions. Please bring your attention to 2
functions that I have problem with, they are WebTextRead() at line 106 and
WebReturn() at line 127. You can skip the write/ln functions as I believe they
have work well.
The problem with read/ln procedures is that I keep losing the first input
variabel content. What I meant 'losing' is the values got shifted to the next
variable. Here's for example:
program test;
{$mode objfpc}{$H+}
uses
WebText;
var
s, t, u: string;
begin
Write('Enter your last name: ');
Read(s); Writeln;
Write('Enter your first name: ');
Read(t); Writeln;
Write('Enter your pet name: ');
Read(u); Writeln;
Write('Your full name is: ', s+', '+t+', '+u);
Writeln;
end.
If I enter values 'var1' to s, 'var2' to t, and 'var3' to u, the result become:
s contains nothing (empty/null?), t contains 'var1', and u contains 'var2'. I
don't understand why it becomes like that. I think all code and logic is already
in order.
Any help is very much appreciated. Thanks in advance.
-Bee-
has Bee.ography at:
http://beeography.wordpress.com
unit WebText;
{$mode objfpc}{$H+}
//{$DEFINE PWU_STATIC}
interface
const
WebAppExt: shortString = {$IFDEF WINDOWS}'.exe'{$ELSE}'.psp'{$ENDIF};
// assigns write and writeln to the webwrite routine
procedure AssignWeb(var F: Text);
// restores normal functionality of write and writeln
procedure RestoreNormalWrite;
implementation
uses
CompactSysUtils,
{$IFDEF PWU_STATIC}
PWUMain;
{$ELSE}
DynPWU;
{$ENDIF}
{ the definitions of TextRec and FileRec are in separate files }
{$i textrec.inc}
(* output flush handler start here *)
const
{ buffered output }
OutSize = 1024;
{ if true then don't buffer output }
WebFlush: boolean = false;
var
{ to save the old input and output variables }
OldInput, OldOutput: Text;
OldLineEnd: TLineEndStr;
OutBuf: array[0..OutSize-1] of char;
OutCnt, VarCnt: longint;
// flush output buffer
procedure WebFlushOutput;
var
s: string;
begin
// fill output buffer
if OutCnt > 0 then
begin
SetLength(s, OutCnt+1);
Move(OutBuf[0], s[1], OutCnt);
s[OutCnt+1] := #0;
WebWrite(s);
OutCnt := 0;
end;
// close web form, if exist (output must be buffered)
if VarCnt > 0 then
begin
WebWrite('<input type="submit" value="SUBMIT">');
WebWrite('</form>');
VarCnt := 0;
end;
end;
// web flush option
function WebSetFlush(AFlushed: boolean): boolean;
begin
Result := WebFlush;
WebFlush := AFlushed;
if WebFlush then WebFlushOutput;
end;
(* web output redirection handler start here *)
// top level function for WebTextWrite
function WebTextWrite(var F: TextRec): integer;
var
s: shortString;
i, idx: longint;
//oldFlush: boolean;
begin
idx := 0;
//oldFlush := WebSetFlush(Flushing);
while (F.BufPos > 0) do
begin
i := F.BufPos;
if i > 255 then i := 255;
Move(F.BufPTR^[idx], s[1], i);
SetLength(s, i);
// here is the magic
WebWrite(s);
Dec(F.BufPos, i);
Inc(idx, i);
end;
//WebSetFlush(oldFLush);
Result := 0;
end;
// top level function for WebTextRead
function WebTextRead(var F: TextRec): integer;
begin
// set default web form id and action
if VarCnt = 0 then
WebWrite('<form method="GET" action="'+
ChangeFileExt(ExtractFileName(Paramstr(0)),'')+
WebAppExt+'">');
// increase variable index
Inc(VarCnt);
// var is not found, generate form
if not IsCGIVar('var'+IntToStr(VarCnt)) then
WebWrite('<input type="text" name="var'+IntToStr(VarCnt)+'">')
else
WebWrite(GetCGIVar('var'+IntToStr(VarCnt)));
Result := 0;
end;
// value for overrided method
function WebReturn(var F: TextRec): integer;
var
s,v: string;
i,l: integer;
begin
l := 0;
v := IntToStr(VarCnt);
// var is found, fill input buffer
if IsCGIVar('var'+v) then
begin
// get value and write to remote
s := GetCGIVar('var'+v);
l := Length(s);
// set buffer length
F.BufPos := 0;
F.BufEnd := l;
// copy per char
for i := 1 to l do F.BufPtr^[i-1] := s[i];
end;
Result := 0;
end;
// close web associated file
function WebClose(var F: TextRec): integer;
begin
F.Mode := fmClosed;
Result := 0;
end;
// open web associated file
function WebOpen(var F: TextRec): integer;
begin
if F.Mode = fmOutput then
begin
TextRec(F).InOutFunc := @WebTextWrite;
TextRec(F).FlushFunc := @WebTextWrite;
end
else
begin
F.Mode := fmInput;
//TextRec(F).InOutFunc := TextRec(OldInput).InOutFunc;
//TextRec(F).FlushFunc := TextRec(OldInput).FlushFunc;
TextRec(F).InOutFunc := @WebTextRead;
TextRec(F).FlushFunc := @WebReturn;
end;
TextRec(F).CloseFunc := @WebClose;
Result := 0;
end;
// redirect output to web (WebWrite function)
procedure AssignWeb(var F: Text);
begin
Assign(F, '');
// save the old line end chars
OldLineEnd := TextRec(OldOutput).LineEnd;
// simulate new line, unfortunately TLineEnd only store 3 chars so we can't
use <BR>
TextRec(F).LineEnd := '<P>';
TextRec(F).OpenFunc := @WebOpen;
end;
// restore output direction to normal tty
procedure RestoreNormalWrite;
begin
WebFlushOutput;
// restore line end chars
TextRec(OldOutput).LineEnd := OldLineEnd;
Move(OldOutput, Output, SizeOf(TextRec));
Move(OldInput, Input, SizeOf(TextRec));
end;
initialization
// global var init
VarCnt := 0;
// save the old input and output vars
Move(Output, OldOutput, SizeOf(TextRec));
Move(Input, OldInput, SizeOf(TextRec));
// redirect the standard input/output
AssignWeb(Input);
Reset(Input);
AssignWeb(Output);
Rewrite(Output);
TextRec(Output).Handle := StdOutputHandle;
finalization
WebFlushOutput;
end.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
