dws2weblibmodule.pas

script language

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsCookieEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.CookieFields.Values[Info['Name']];
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsCookieNameEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.CookieFields.Names[Info['Index']];
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsCookieValueEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  name: string;
begin
  name := FHttpInfo.HttpRequest.CookieFields.Names[Info['Index']];
  Info['Result'] :=
    FHttpInfo.HttpRequest.CookieFields.Values[name];
end;

procedure Tdws2WebLib.dws2WebUnitClassesResponseMethodsCookieCountEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpResponse.Cookies.Count;
end;

procedure Tdws2WebLib.dws2WebUnitClassesResponseMethodsCookieEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    Info.Vars['TCookie'].GetConstructor('Create',
    FHttpInfo.HttpResponse.Cookies[Info['Index']]
    ).Call.Value;
end;

procedure Tdws2WebLib.dws2WebUnitClassesResponseMethodsCookieByNameEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  x: Integer;
  name: string;
  cookies: TCookieCollection;
begin
  name := Info['Name'];
  cookies := FHttpInfo.HttpResponse.Cookies;
  for x := 0 to cookies.Count - 1 do
    if AnsiSameText(cookies[x].Name, name) then
    begin
      Info['Result'] :=
        Info.Vars['TCookie'].GetConstructor('Create', cookies[x]).Call.Value;
      exit;
    end;
  Info['Result'] := 0;
end;

procedure Tdws2WebLib.dws2WebUnitClassesResponseMethodsNewCookieEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    Info.Vars['TCookie'].GetConstructor('Create',
    FHttpInfo.HttpResponse.Cookies.Add
    ).Call.Value;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsParamsEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  x: Integer;
  name: string;
  strs, params: TStrings;
begin
  name := Info['Name'];
  strs := FHttpInfo.Params;
  params := TStringList.Create;
  for x := 0 to strs.Count - 1 do
    if AnsiSameText(strs.Names[x], name) then
    begin
      if Pos('=', strs[x]) > 0 then
        params.Add(Copy(strs[x], Pos('=', strs[x]) + 1, Length(strs[x])))
      else
        params.Add('');
    end;

  //  Info['Result'] := Info.Vars['TStrings'].GetConstructor('Create', params).Value;
  // changed by hannes to skip dependecy from ClassesLib!
  // with this change, function params is compatible to all DWS TStrings solutions (VCL, Classes..)

  Info['Result'] := params.Text;
  params.Free;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsLogContentEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with FHttpInfo.HttpRequest do
  begin
    Info['Result'] := 'ContentFields ' + ContentFields.Text + #10#13
      + 'QueryFields ' + QueryFields.Text + #10#13
      + 'Accept ' + Accept + #10#13
      + 'CacheControl ' + CacheControl + #10#13
      + 'Connection ' + Connection + #10#13
      + 'ContentEncoding ' + ContentEncoding + #10#13
      + 'ContentType ' + ContentType + #10#13
      + 'ContentVersion ' + ContentVersion + #10#13
      + 'Cookie ' + Cookie + #10#13
      + 'DerivedFrom ' + DerivedFrom + #10#13
      + 'From ' + From + #10#13
      + 'Host ' + Host + #10#13
      + 'Method ' + Method + #10#13
      + 'PathInfo ' + PathInfo + #10#13
      + 'PathTranslated ' + PathTranslated + #10#13
      + 'ProtocolVersion ' + ProtocolVersion + #10#13
      + 'Query ' + Query + #10#13
      + 'Referer ' + Referer + #10#13
      + 'RemoteAddr ' + RemoteAddr + #10#13
      + 'RemoteHost ' + RemoteHost + #10#13
      + 'ScriptName ' + ScriptName + #10#13
      + 'Title ' + Title + #10#13
      + 'URL ' + URL + #10#13
      + 'UserAgent ' + UserAgent + #10#13
      + 'Authorization ' + Authorization + #10#13;
  end;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsAcceptEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := FHttpInfo.HttpRequest.Accept;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsMethodEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := FHttpInfo.HttpRequest.Method;
end;

procedure Tdws2WebLib.dws2WebUnitFunctionsRtfToHtmlEval(
  Info: TProgramInfo);
var
  sH: string;
begin
  sH := Info['RtfStr'];
  Info['Result'] := StringReplace(sH, #13, '<br>', [rfReplaceAll]);
end;

procedure Tdws2WebLib.dws2WebUnitFunctionsFormVarEval(Info: TProgramInfo);
begin
  Info['Result'] :=
    FHttpInfo.Params.Values[Info['ParamName']];
end;

function Tdws2WebLib.ActivateDumpScript(DumpStr: string): string;
begin
  DumpStr := StringReplace(DumpStr, FDumpPatternOpen,
    Tdws2HtmlFilter(Script.Config.Filter).PatternOpen, [rfReplaceAll]);
  Result := StringReplace(DumpStr, FDumpPatternClose,
    Tdws2HtmlFilter(Script.Config.Filter).PatternClose, [rfReplaceAll]);
end;

procedure Tdws2WebLib.dws2WebUnitFunctionsTrimURLEval(Info: TProgramInfo);
var
  sH: string;
begin
  sH := Info['sURL'];
  if pos('HTTP://', uppercase(sH)) = 1 then
    delete(sH, 1, 7);
  Info['Result'] := sH;
end;

procedure Tdws2WebLib.dws2WebUnitFunctionsacceptWMLEval(
  Info: TProgramInfo);
begin
  if (pos('wml', FHttpInfo.HttpRequest.Accept) = 0) then
    Info['Result'] := false
  else
  begin
    Info['Result'] := true;
    FHttpInfo.HttpResponse.ContentType := 'text/vnd.wap.wml';
  end;
end;

procedure Tdws2WebLib.dws2WebUnitFunctionsURLencodeEval(
  Info: TProgramInfo);
var
  i, iMax: Integer;
  sH, sURL: string;
begin
  sH := '';
  sURL := Info['sURL'];
  iMax := Length(sURL);
  for i := 1 to iMax do
    if sURL[i] < #64 then
      sH := sH + '%' + IntToHex(Ord(sURL[i]), 2)
    else
      sH := sH + sURL[i];
  Info['Result'] := sH;
end;

procedure Tdws2WebLib.dws2WebUnitFunctionsURLdecodeEval(
  Info: TProgramInfo);
var
  ch: Char;
  sURL, sH: string;
  i: Integer;
begin
  sURL := Info['sURL'];
  i := Pos('%', sURL);
  while i > 0 do
  begin
    sH := '$' + Copy(sURL, i + 1, 2);
    Ch := Char(StrToInt(sH));
    sURL := Copy(sURL, 1, i - 1) + Ch + Copy(sURL, i + 3, Length(sURL));
    i := Pos('%', sURL);
  end;
  i := Pos('+', sURL);
  while i > 0 do
  begin
    sURL := Copy(sURL, 1, i - 1) + #32 + Copy(sURL, i + 1, Length(sURL));
    i := Pos('+', sURL);
  end;
  Info['Result'] := sURL;
end;

procedure Tdws2WebLib.dws2WebUnitFunctionsforwardEval(Info: TProgramInfo);
begin
  raise EForward.Create(Info['Newfile']);
end;

procedure Tdws2WebLib.customWebUnitClassesTFormVarGroupConstructorsCreateAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
begin
  ExtObject := TFormVarGroupObj.create(TStringList(FHttpInfo.Params));
end;

procedure Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodsSetPrefixEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TFormVarGroupObj(ExtObject).Prefix := Info['Prefix'];
end;

procedure Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodsGetPrefixEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TFormVarGroupObj(ExtObject).Prefix;
end;

procedure
  Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodsSetAddNullFieldsEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TFormVarGroupObj(ExtObject).AddNullFields := Info['Value'];
end;

procedure Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodscountEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TFormVarGroupObj(ExtObject).Count;
end;

procedure Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodsExtEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TFormVarGroupObj(ExtObject).Ext;
end;

procedure Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodsValueEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TFormVarGroupObj(ExtObject).Value;
end;

procedure
  Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodsGetAddNullFieldsEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TFormVarGroupObj(ExtObject).AddNullFields;
end;

procedure Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodsEofEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TFormVarGroupObj(ExtObject) do
    Info['Result'] := (RecNr >= Count) or (RecNr < 0);
end;

procedure Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodsFirstEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TFormVarGroupObj(ExtObject).RecNr := 0;
end;

procedure Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodsNextEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TFormVarGroupObj(ExtObject).RecNr := TFormVarGroupObj(ExtObject).RecNr + 1;
end;

procedure Tdws2WebLib.customWebUnitClassesTFormVarGroupMethodsRecNrEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TFormVarGroupObj(ExtObject).RecNr;
end;

procedure Tdws2WebLib.SetNeedLoginDWSErrorFile(const Value: string);
begin
  FNeedLoginDWSErrorFile := Value;
end;

procedure Tdws2WebLib.SetNeedMemberLoginDWSErrorFile(const Value: string);
begin
  FNeedMemberLoginDWSErrorFile := Value;
end;

procedure Tdws2WebLib.SetNeedSessionDWSErrorFile(const Value: string);
begin
  FNeedSessionDWSErrorFile := Value;
end;

end.