//Advanced Delphi Systems Code: ads_wbServer
{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
Please note if you are viewing this Delphi unit as a web page all you have to
do to turn it into a Delphi unit is save it with a ".pas" extension. The
html in the unit should not affect its performance.
}
unit ads_wbServer;
(*UnitIndex Master Index Implementation Section Download Units
Description: ads_wbServer.pas
This unit contains the following routines.
AdvDelphiSysComment
CheckLoginDatabase
CleanUnEncryptedField
Counter
DeEncryptAndCleanField
DeEncryptString
DeEncryptValidate
DeleteItemsFromList
EncryptString
ER
FieldList
FieldsInit
FieldsUpdate
FieldTypeToStr
FieldValuesStrToLst
FileToStr
GetDBImageByRecno
GetEncryptedLoginID
GetEncryptedPwd
GetLoginID
GetPwd
GetRequestInfo
MakeAccessDenied
MakeBrowserPage
MakeDBNamesPage
MakeFieldNamesPage
MakeFormatPage
MakeLogin
MakeOptionsPage
MakePageFooter
MakePageHeader
MakeSaveAsServerFinishedPage
MakeSaveAsServerPage
MakeSearchPage
MakeTableNamesPage
MinMaxStrFieldTypes
PageHeader
PublishDebugData
RaiseError
ReplaceStringInString
SaveErrorLog
ShouldIGenList
StrToFieldType
SyncConfigParams
TWebServerDB.Database1Login
WriteDBImageToFile
WriteErrors
*)
interface
uses
Windows, Messages, SysUtils, Classes, HTTPApp, Graphics, DBTables, DB,
FieldClass, ads_wbserver_util, dbctrls;
Type
TWebServerDB = Class(TDatabase)
procedure Database1Login(Database: TDatabase; LoginParams: TStrings);
End;
Procedure RaiseError(UnitName,ProcName:String;E : Exception);
Procedure SaveErrorLog;
procedure WriteDBImageToFile(
Var DataSet : TDataSet;
FieldName : String;
FileName : String);
Function MakeSaveAsServerFinishedPage(
ActionURL : String;
DatabaseName: String;
TableName : String;
Role : String;
LoadBalance : String;
BufferSize : String;
FieldValues : String;
SourceServer: String;
ServerName : String;
lst : TStrings
): String;
Function MakeSaveAsServerPage(
ActionURL : String;
DatabaseName: String;
TableName : String;
Role : String;
LoadBalance : String;
BufferSize : String;
FieldValues : String;
SourceServer: String;
lst : TStrings
): String;
Function PublishDebugData(PageStr: String;Values: TWebRequest): String;
Function Counter: String;
Function FieldList(
Request : TWebRequest;
FieldPrefix : String
): String;
Function FieldValuesStrToLst(
Var lst : TStringList;
FieldValues : String;
ListName : String): Boolean;
Function MakeOptionsPage(
ActionURL : String;
DatabaseName: String;
TableName : String;
LoadBalance : String;
BufferSize : String;
Button : String;
Values : String;
FieldValues : String
): String;
Function MakeSearchPage(
ActionURL : String;
DatabaseName: String;
TableName : String;
LoadBalance : String;
BufferSize : String;
Button : String;
Values : String;
FieldValues : String
): String;
Function MakeFormatPage(
ActionURL : String;
DatabaseName: String;
TableName : String;
LoadBalance : String;
BufferSize : String;
Button : String;
Values : String;
FieldValues : String
): String;
Function StrToFieldType(FieldType : String): TFieldType;
Function FieldTypeToStr(FieldType : TFieldType): String;
Function MinMaxStrFieldTypes(FieldType : String): Boolean;
Function FieldsUpdate(
FieldDisplay : TStringList;
FieldMax : TStringList;
FieldMin : TStringList;
FieldNames : TStringList;
FieldNumber : TStringList;
FieldOrder : TStringList;
FieldSize : TStringList;
FieldType : TStringList;
FieldVisible : TStringList;
TableData : TStringList;
SaveToFile : Boolean
): String;
Function FieldsInit(
DatabaseName: String;
TableName : String;
LoadBalance : String;
BufferSize : String;
Role : String
): String;
Function CheckLoginDatabase(
DatabaseName : String;
TableName : String;
LoadBalance : String;
BufferSize : String
): Boolean;
Function DeEncryptAndCleanField(
Request: TWebRequest;
Field : String
): String;
Function CleanUnEncryptedField(
Request: TWebRequest;
Field : String
): String;
Function MakeFieldNamesPage(
ActionURL : String;
DatabaseName: String;
TableName : String;
LoadBalance : String;
BufferSize : String;
Button : String;
Values : String;
FieldValues : String
): String;
Function MakeBrowserPage(
ActionURL : String;
DatabaseName: String;
TableName : String;
LoadBalance : String;
BufferSize : String;
Role : String;
RecNo : String;
RecMax : String;
FieldList : String;
NavButton : String;
lst : TStrings
): String;
Function ShouldIGenList(var lst : TStringList): Boolean;
Function DeleteItemsFromList(InputList : String): String;
Function MakeLogin: String;
Function PageHeader: String;
Function AdvDelphiSysComment: String;
Procedure FileToStr(
Var Str : String;
FileName : String);
Function GetRequestInfo(
Request: TWebRequest;
AsTable: Boolean): String;
procedure GetDBImageByRecno(
Sender : TObject;
Request : TWebRequest;
Response : TWebResponse;
var Handled : Boolean);
Function MakeTableNamesPage(
ActionURL : String;
DatabaseName: String;
LoadBalance : String;
BufferSize : String;
lst : TStrings
): String;
Function MakeDBNamesPage(
ActionURL : String;
LoadBalance : String;
BufferSize : String;
lst : TStrings
): String;
Function GetLoginID(Request : TWebRequest): String;
Function GetPwd(Request : TWebRequest): String;
Function GetEncryptedLoginID(Request : TWebRequest): String;
Function GetEncryptedPwd(Request : TWebRequest): String;
Function EncryptString(sg : String): String;
Function DeEncryptString(sg : String): String;
Function MakePageHeader(
HTMLMetaDataTitle : String;
HTMLMetaDataAuthor : String;
HTMLMetaDataKeywords : String;
HTMLMetaDataDesc : String;
MainTitle : String;
SubTitle : String;
BackGround : String;
DebugData : Boolean
): String;
Function MakePageFooter: String;
Function ReplaceStringInString(
SourceString : String;
OldString : String;
NewString : String
): String;
Procedure MakeAccessDenied;
Procedure SyncConfigParams(
var ConfigParam : String;
sgConfigParam : String);
Function ER(
ProcName : String;
Group : String;
Var E : Exception): String;
Var
ConfigParams : TStringList;
ConfigParamsWas : String;
ButtonShowDB : String;
ButtonShowSaveAsServer : String;
ButtonShowTable : String;
ButtonShowFields : String;
ButtonShowFilter : String;
DBLoadDatabaseName : String;
DBLoadFieldValues : String;
DBLoadRole : String;
DBLoadTableName : String;
DBSaveDatabaseName : String;
DBSaveFieldValues : String;
DBSaveRole : String;
DBSaveTableName : String;
DBValueDatabaseName : String;
DBValueFieldValues : String;
DBValueRole : String;
DBValueTableName : String;
DebugDataPublish : String;
Errors : TStringList;
ErrorsSaveToFile : String;
ExecutableName : String;
ExecutablePath : String;
FileConfiguration : String;
FileHTMLPageFooter : String;
FileHTMLPageHeader : String;
FileListDelete : String;
FileListOfOnlyItems : String;
FileMetaDataDescription : String;
FileMetaDataKeywords : String;
HTMLHideSource : String;
HTMLHideString : String;
HTMLMetaDataAuthor : String;
HTMLMetaDataDesc : String;
HTMLMetaDataKeywords : String;
HTMLMetaDataTitle : String;
HTMLPageFooter : String;
HTMLPageHeader : String;
HTMLTable2CellPadding : String;
HTMLTable2CellSpacing : String;
HTMLTable2ColorBackGrd : String;
HTMLTable2ColorBorder : String;
HTMLTable2ColorFont : String;
HTMLTable2FontSize : String;
HTMLTable3CellPadding : String;
HTMLTable3CellSpacing : String;
HTMLTable3ColorBackGrd : String;
HTMLTable3ColorBorder : String;
HTMLTable3ColorFont : String;
HTMLTable3FontSize : String;
HTMLTableCellPadding : String;
HTMLTableCellSpacing : String;
HTMLTableColorBackGrd : String;
HTMLTableColorBorder : String;
HTMLTableColorFont : String;
HTMLTableFontSize : String;
HTMLTitleMain : String;
HTMLTitleMainColor : String;
HTMLTitleMainSize : String;
HTMLTitleSub : String;
HTMLTitleSubColor : String;
HTMLTitleSubSize : String;
ListOfItemsToDelete : String;
ListOfOnlyDisplayItems : String;
MeterCounterBold : String;
MeterCounterColorBackGrd : String;
MeterCounterColorBorder : String;
MeterCounterColorFont : String;
MeterCounterFontSize : String;
MeterCounterItalics : String;
MeterCounterShow : String;
MeterDateBold : String;
MeterDateColorBackGrd : String;
MeterDateColorBorder : String;
MeterDateColorFont : String;
MeterDateFontSize : String;
MeterDateItalics : String;
MeterDateShow : String;
MeterTimeBold : String;
MeterTimeColorBackGrd : String;
MeterTimeColorBorder : String;
MeterTimeColorFont : String;
MeterTimeFontSize : String;
MeterTimeItalics : String;
MeterTimeShow : String;
sgBoolean : String;
URLAction : String;
URLAction2 : String;
URLAction3 : String;
URLAction4 : String;
URLBackground : String;
URLImageTop : String;
URLScriptDir : String;
GlobalLogErrors : Boolean;
GlobalErrorLog : TStringList;
RaiseErrors : Boolean;
implementation
uses JPeg;
const UnitName = 'ads_wbServer';
//Unit Description UnitIndex Master Index
Procedure RaiseError(UnitName,ProcName:String;E : Exception);
Begin
If GlobalLogErrors Then
GlobalErrorLog.Add(FormatDateTime('yyddmmhhnnss',now())+' '+UnitName+'.'+Procname+' error: '+E.Message);
If RaiseErrors Then Raise Exception.Create(UnitName+'.'+Procname+' error: '+E.Message);
End;
//Unit Description UnitIndex Master Index
Procedure SaveErrorLog;
Var
lst : TStringList;
inCounter : Integer;
ErrorFile : String;
ProcName : String;
begin
ProcName := 'SaveErrorLog'; Try
lst := TStringList.create();
Try
lst.Clear;
ErrorFile := ExecutablePath+Copy(ExecutableName,1,Length(ExecutableName)-3)+'err';
If FileExists(ErrorFile) Then
lst.LoadFromFile(ErrorFile);
GlobalErrorLog.SetText(PChar(GlobalErrorLog.Text+lst.Text));
GlobalErrorLog.Sorted := True;
GlobalErrorLog.Sorted := False;
lst.Clear;
For inCounter := 0 To GlobalErrorLog.Count - 1 Do
Begin
lst.Add(GlobalErrorLog[inCounter]);
End;
If lst.Count > 0 Then lst.SaveToFile(ErrorFile);
Finally
lst.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
procedure TWebServerDB.Database1Login(Database: TDatabase;
LoginParams: TStrings);
Var
ProcName : String;
begin
ProcName := 'TWebServerDB.Database1Login'; Try
LoginParams.Clear;
LoginParams.Add('USER NAME='+Params.Values['USER NAME']);
LoginParams.Add('PASSWORD=' +Params.Values['PASSWORD']);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
Function DeEncryptValidate(InputString: ShortString): String;
Var
NewString: String;
L : Integer;
i : Integer;
C : Char;
ProcName : String;
Begin
Result := InputString;
ProcName := 'DeEncryptValidate'; Try
NewString := '';
L := Length(InputString);
For i:= 1 To L Do
Begin
C := InputString[i];
Case C of
'0' : NewString := NewString + C;
'1' : NewString := NewString + C;
'2' : NewString := NewString + C;
'3' : NewString := NewString + C;
'4' : NewString := NewString + C;
'5' : NewString := NewString + C;
'6' : NewString := NewString + C;
'7' : NewString := NewString + C;
'8' : NewString := NewString + C;
'9' : NewString := NewString + C;
End;
End;
Result := NewString;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function ER(
ProcName : String;
Group : String;
Var E : Exception): String;
Var
sgRec : String;
dt : TDateTime;
Filler: String;
Begin
Filler := ' ';
dt := now();
sgRec := FormatDateTime('yymmdd',dt);
sgRec := sgRec + FormatFloat('.0000000000',dt)+' ';
ProcName := ProcName + Filler;
Group := Group + Filler;
sgRec := sgRec + Copy(ProcName, 1, 35) + ' ';
sgRec := sgRec + Copy(Group,1,25) + ' ';
sgRec := sgRec + E.Message;
Result :=
''+
''+
''+
''+
'
ERROR MESSAGE
'+
'
'+
sgRec+
''+
'';
If ErrorsSaveToFile = 'TRUE' Then Errors.Add(sgRec);
End;
//Unit Description UnitIndex Master Index
Procedure WriteErrors;
Var
lst : TStringList;
FileName : String;
ProcName : String;
Begin
ProcName := 'WriteErrors'; Try
If ErrorsSaveToFile <> 'TRUE' Then Exit;
FileName := ExecutablePath+'Errors.txt';
If FileExists(FileName) Then
Begin
lst := TStringList.Create();
Try
lst.LoadFromFile(FileName);
lst.SetText(PChar(lst.Text+Errors.Text));
lst.Sorted := True;
lst.SaveToFile(FileName);
Finally
lst.Free;
End;
End
Else
Begin
Errors.SaveToFile(FileName);
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function GetRequestInfo(
Request: TWebRequest;
AsTable: Boolean): String;
Var
lst : TStringList;
CommentStart : String;
CommentEnd : String;
TableStart : String;
TableEnd : String;
RowStart : String;
RowEnd : String;
CellStart : String;
CellEnd : String;
inCounter : Integer;
inPos : Integer;
ProcName : String;
Begin
ProcName := 'GetRequestInfo'; Try
If AsTable Then
Begin
CommentStart := '';
CommentEnd := '';
TableStart := '';
RowStart := '';
RowEnd := '
';
CellStart := '';
CellEnd := ' | ';
End
Else
Begin
CommentStart := '';
TableStart := '';
TableEnd := '';
RowStart := '';
RowEnd := '';
CellStart := '';
CellEnd := '';
End;
lst := TStringList.Create;
Try
With lst Do
Begin
Clear;
Add(CommentStart+''+CommentEnd);
Add(CommentStart+'Requestor Data'+CommentEnd);
Add(CommentStart+'
'+CommentEnd);
Add(CommentStart+TableStart+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Property' +CellEnd+CellStart + 'Value'+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Method' +CellEnd+CellStart + Request.Method+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'ProtocolVersion'+CellEnd+CellStart + Request.ProtocolVersion+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'URL' +CellEnd+CellStart + Request.URL+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Query' +CellEnd+CellStart + Request.Query+CellEnd+RowEnd+CommentEnd);
If Request.Query <> '' Then
Begin
For inCounter := 0 To Request.QueryFields.Count - 1 Do
Begin
Add(
CommentStart+RowStart+CellStart+'QueryFields['+
IntToStr(inCounter)+']' +CellEnd+CellStart + Request.QueryFields[inCounter]+CellEnd+RowEnd+CommentEnd);
inPos := Pos('LoadBalance',Request.QueryFields[inCounter]);
If inPos > 0 Then
Begin
inPos := Pos('=',Request.QueryFields[inCounter]);
If inPos > 0 Then
Begin
Add(
CommentStart+RowStart+CellStart+'QueryFields['+
IntToStr(inCounter)+']' +
CellEnd+CellStart +
'LoadBalance='+
DeEncryptString(Copy(Request.QueryFields[inCounter],inPos+1,255))+
CellEnd+RowEnd+CommentEnd);
End;
End;
inPos := Pos('BufferSize',Request.QueryFields[inCounter]);
If inPos > 0 Then
Begin
inPos := Pos('=',Request.QueryFields[inCounter]);
If inPos > 0 Then
Begin
Add(
CommentStart+RowStart+CellStart+'QueryFields['+
IntToStr(inCounter)+']' +
CellEnd+CellStart +
'BufferSize='+
DeEncryptString(Copy(Request.QueryFields[inCounter],inPos+1,255))+
CellEnd+RowEnd+CommentEnd);
End;
End;
End;
End;
Add(CommentStart+RowStart+CellStart+'PathInfo' +CellEnd+CellStart + Request.PathInfo+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'PathTranslated' +CellEnd+CellStart + Request.PathTranslated+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Authorization' +CellEnd+CellStart + Request.Authorization+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'CacheControl' +CellEnd+CellStart + Request.CacheControl+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Cookie' +CellEnd+CellStart + Request.Cookie+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Date' +CellEnd+CellStart + FormatDateTime ('mmm dd, yyyy hh:mm', Request.Date)+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Accept' +CellEnd+CellStart + Request.Accept+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'From' +CellEnd+CellStart + Request.From+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Host' +CellEnd+CellStart + Request.Host+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'IfModifiedSince'+CellEnd+CellStart + FormatDateTime ('mmm dd, yyyy hh:mm', Request.IfModifiedSince)+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Referer' +CellEnd+CellStart + Request.Referer+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'UserAgent' +CellEnd+CellStart + Request.UserAgent+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'ContentEncoding'+CellEnd+CellStart + Request.ContentEncoding+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'ContentType' +CellEnd+CellStart + Request.ContentType+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'ContentLength' +CellEnd+CellStart + IntToStr(Request.ContentLength)+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'ContentVersion' +CellEnd+CellStart + Request.ContentVersion+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Content' +CellEnd+CellStart + Request.Content+CellEnd+RowEnd+CommentEnd);
If Request.Content <> '' Then
Begin
For inCounter := 0 To Request.ContentFields.Count - 1 Do
Begin
Add(
CommentStart+RowStart+CellStart+'ContentFields['+
IntToStr(inCounter)+']' +CellEnd+CellStart + Request.ContentFields[inCounter]+CellEnd+RowEnd+CommentEnd);
inPos := Pos('LoadBalance',Request.ContentFields[inCounter]);
If inPos > 0 Then
Begin
inPos := Pos('=',Request.ContentFields[inCounter]);
If inPos > 0 Then
Begin
Add(
CommentStart+RowStart+CellStart+'ContentFields['+
IntToStr(inCounter)+']' +
CellEnd+CellStart +
'LoadBalance='+
DeEncryptString(Copy(Request.ContentFields[inCounter],inPos+1,255))+
CellEnd+RowEnd+CommentEnd);
End;
End;
inPos := Pos('BufferSize',Request.ContentFields[inCounter]);
If inPos > 0 Then
Begin
inPos := Pos('=',Request.ContentFields[inCounter]);
If inPos > 0 Then
Begin
Add(
CommentStart+RowStart+CellStart+'ContentFields['+
IntToStr(inCounter)+']' +
CellEnd+CellStart +
'BufferSize='+
DeEncryptString(Copy(Request.ContentFields[inCounter],inPos+1,255))+
CellEnd+RowEnd+CommentEnd);
End;
End;
End;
End;
Add(CommentStart+RowStart+CellStart+'Connection' +CellEnd+CellStart + Request.Connection+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'DerivedFrom' +CellEnd+CellStart + Request.DerivedFrom+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Expires' +CellEnd+CellStart + FormatDateTime ('mmm dd, yyyy hh:mm', Request.Expires)+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'Title' +CellEnd+CellStart + Request.Title+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'RemoteAddr' +CellEnd+CellStart + Request.RemoteAddr+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'RemoteHost' +CellEnd+CellStart + Request.RemoteHost+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'ScriptName' +CellEnd+CellStart + Request.ScriptName+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+RowStart+CellStart+'ServerPort' +CellEnd+CellStart + IntToStr(Request.ServerPort)+CellEnd+RowEnd+CommentEnd);
Add(CommentStart+TableEnd+CommentEnd);
End;
lst.Add(CommentStart+'Start Configuration file Entries'+CommentEnd);
For inCounter := 0 To ConfigParams.Count - 1 Do
Begin
lst.Add(CommentStart+ConfigParams[inCounter]+CommentEnd);
End;
lst.Add(CommentStart+'End Configuration file Entries'+CommentEnd);
Result := lst.text;
Finally
lst.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
procedure GetDBImageByRecno(
Sender : TObject;
Request : TWebRequest;
Response : TWebResponse;
var Handled : Boolean);
var
Jpeg : TJpegImage;
MemoryStream : TMemoryStream;
Picture : TPicture;
DatabaseName : String;
TableName : String;
FieldName : String;
RecNo : String;
RecNum : Integer;
inCounter : Integer;
qry : TQuery;
Graphic : TGraphicField;
ProcName : String;
begin
ProcName := 'GetDBImageByRecno';
Try
qry := TQuery.Create(nil);
DatabaseName := Request.QueryFields.Values['DatabaseName'];
TableName := Request.QueryFields.Values['TableName'];
FieldName := Request.QueryFields.Values['FieldName'];
RecNo := Request.QueryFields.Values['RecNo'];
Try
RecNum := StrToInt(RecNo);
Except
RecNum := 1;
End;
Graphic := TGraphicField.Create(nil);
Jpeg := TJpegImage.Create;
Try
qry.Active := False;
qry.DatabaseName := DatabaseName;
qry.RequestLive := False;
qry.Sql.Clear;
qry.Sql.Add('Select');
qry.Sql.Add(FieldName);
qry.Sql.Add('From');
If Pos('.DB',UpperCase(TableName)) > 0 Then
Begin
qry.Sql.Add('"'+TableName+'"');
End
Else
Begin
qry.Sql.Add(TableName);
End;
Graphic.FieldName := FieldName;
Graphic.BlobType := ftGraphic;
//qry.sql.add('/* '+'RecNo=' +RecNo +' */');
//qry.sql.add('/* '+'RecNum=' +IntToStr(RecNum)+' */');
//qry.sql.add('/* '+'DatabaseName='+Databasename +' */');
//qry.sql.add('/* '+'TableName=' +Tablename +' */');
//qry.sql.add('/* '+'FieldName=' +FieldName +' */');
Graphic.DataSet := qry;
qry.Active := True;
qry.First;
For inCounter := 1 To RecNum Do
Begin
If inCounter = RecNum Then
Begin
Break;
End
Else
Begin
qry.Next;
End;
End;
Picture := TPicture.Create;
Picture.Assign(Graphic);
qry.Active := False;
Jpeg.Assign(Picture.Graphic);
MemoryStream := TMemoryStream.Create;
Try
Jpeg.SaveToStream(MemoryStream);
MemoryStream.Position := 0;
Response.ContentType := 'image/jpeg';
Response.ContentStream := MemoryStream;
Response.SendResponse;
Finally
Picture.Free;
MemoryStream.Free;
End;
Handled := True;
Finally
Jpeg.Free;
qry.Free;
Graphic.Free;
End;
Except
On E : Exception Do
Begin
RaiseError(UnitName,ProcName,E);
ER(ProcName,'all',E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function EncryptString(sg : String): String;
Var
inCounter : Integer;
inDOY : Integer;
flDOY : Double;
dtToday : TDateTime;
dtFirst : TDateTime;
Str : String;
sgChar : String;
pcChar : PChar;
chChar : Char;
inChar : Integer;
sgInChar : String;
insgLen : Integer;
inCharLen : Integer;
ProcName : String;
Begin
ProcName := 'EncryptString';
Try
dtToday := now();
dtFirst := StrToDateTime(FormatDateTime('1/1/yyyy',dtToday));
flDOY := dtToday - dtFirst + 1;
inDOY := StrToInt(FormatFloat('#0',flDOY));
sgChar := '';
sgInChar := '';
Str := '';
insgLen := Length(sg);
For inCounter := 1 To insgLen Do
Begin
sgChar := Copy(sg,inCounter,1);
pcChar := PChar(sgChar);
chChar := pcChar[0];
inChar := Ord(chChar);
If inChar = 10 Then Continue;
If inChar = 13 Then Continue;
If inChar = 9 Then Continue;
inChar := inChar + inDOY;
If Odd(inCounter) Then
Begin
inChar := inChar - inCounter;
End
Else
Begin
inChar := inChar + inCounter;
End;
sgInChar := IntToStr(inChar);
inCharLen:= Length(sgInChar);
Case inCharLen Of
0 : sgInChar := '000'+sgInChar;
1 : sgInChar := '00'+sgInChar;
2 : sgInChar := '0'+sgInChar;
3 : sgInChar := ''+sgInChar;
End;
Str := Str + sgInChar;
End;
Str := Str + '677968';
Str := Str + IntToStr(inDOY + 486772);
Str := Str + IntToStr(inDOY + 967465);
Str := Str + IntToStr(inDOY + 601754);
Str := Str + IntToStr(inDOY + 629573);
Str := Str + IntToStr(inDOY + 566285);
Str := Str + IntToStr(inDOY + 835649);
Str := Str + IntToStr(inDOY + 907835);
Str := Str + IntToStr(inDOY + 541653);
Str := Str + IntToStr(inDOY + 905906);
Str := Str + IntToStr(inDOY + 756907);
Str := Str + IntToStr(inDOY + 835665);
Str := Copy(Str,1,66);
Result := Str;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function DeEncryptString(sg : String): String;
Var
inCounter : Integer;
inDOY : Integer;
flDOY : Double;
dtToday : TDateTime;
dtFirst : TDateTime;
Str : String;
sgChar : String;
inChar : Integer;
sgInChar : String;
ProcName : String;
inPos : Integer;
inMax : Integer;
Begin
ProcName := 'DeEncryptString';
Try
sg := DeEncryptValidate(sg);
inChar := 0;
inPos := Pos('677968',sg);
If inPos < 4 Then
Begin
Result := '';
Exit;
End;
sg := Copy(sg,1,inPos-1);
dtToday := now();
dtFirst := StrToDateTime(FormatDateTime('1/1/yyyy',dtToday));
flDOY := dtToday - dtFirst + 1;
inDOY := StrToInt(FormatFloat('#0',flDOY));
sgChar := '';
sgInChar := '';
Str := '';
inMax := Length(sg) div 3;
For inCounter := 1 To inMax Do
Begin
sgInChar := Copy(sg,1,3);
sg := Copy(sg,4,60);
Try
inChar := StrToInt(sgInChar)-inDOY;
Except
Continue;
End;
If Odd(inCounter) Then
Begin
inChar := inChar + inCounter;
End
Else
Begin
inChar := inChar - inCounter;
End;
Str := Str + Chr(inChar);
If Length(sg) = 0 Then Break;
End;
Result := Str;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function MakeTableNamesPage(
ActionURL : String;
DatabaseName: String;
LoadBalance : String;
BufferSize : String;
lst : TStrings
): String;
var
TableNames: TStringList;
i : Integer;
ProcName : String;
Page : TStringList;
DBName : TWebServerDB;
TableName : String;
begin
ProcName := 'MakeTableNamesPage';
Try
DatabaseName := DeEncryptString(EncryptString(Trim(DatabaseName)));
ActionURL := DeEncryptString(EncryptString(Trim(ActionURL)));
LoadBalance := EncryptString(DeEncryptString(Trim(LoadBalance)));
BufferSize := EncryptString(DeEncryptString(Trim(BufferSize)));
Page := TStringList.Create();
TableNames := TStringList.Create;
DBName := TWebServerDB.Create(nil);
TableName := lst.Values['Table'];
Try
If ShouldIGenList(TableNames) Then
Begin
DBName.LoginPrompt := False;
DBName.DatabaseName := 'DBName';
DBName.AliasName := DatabaseName;
DBName.KeepConnection := True;
DBName.Params.Clear;
DBName.Params.Add('USER NAME='+DeEncryptString(LoadBalance));
DBName.Params.Add('PASSWORD='+DeEncryptString(BufferSize));
Try
DBName.Connected := True;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'Connection',E);
Exit;
End;
End;
TableNames.Sorted := True;
DBname.Session.GetTableNames(
'DBName',
'',
True,
False,
TableNames);
TableNames.SetText(PChar(DeleteItemsFromList(TableNames.Text)));
End;
Page.SetText(PChar(PageHeader));
Page.Add('');
Page.Add('');
Page.Add('| ');
Page.Add('');
Page.Add(DatabaseName+' Database');
Page.Add('');
Page.Add(' | ');
Page.Add('
');
Page.Add('');
Page.Add('| ');
Page.Add('');
Page.Add('Please select a database table.');
Page.Add('');
Page.Add(' | ');
Page.Add('
');
Page.Add('');
//Page.Add('
');
//Page.Add('| ');
Page.Add(' | ');
Page.Add(' | ');
Page.Add('');
Page.Add('');
//Page.Add(' | ');
//Page.Add(' | ');
Page.Add('');
Page.Add('
');
Page.Add('
');
Page.SetText(PChar(Page.Text+ MakePageFooter));
Result := Page.Text;
Finally
Page .Free;
TableNames.Free;
DBName .Free;
End
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function MakePageHeader(
HTMLMetaDataTitle : String;
HTMLMetaDataAuthor : String;
HTMLMetaDataKeywords : String;
HTMLMetaDataDesc : String;
MainTitle : String;
SubTitle : String;
BackGround : String;
DebugData : Boolean
): String;
Var
Page : TStringList;
ProcName : String;
inCounter: Integer;
Begin
ProcName := 'MakePageHeader';
Try
Page := TStringList.Create();
Try
Page.Clear;
Page.Add('');
Page.Add('');
sgBoolean := HTMLHideSource;
If (UpperCase(Copy(sgBoolean,1,1))= 'T') Then
Begin
//sgBoolean := DebugDataPublish;
//If Not (UpperCase(Copy(sgBoolean,1,1))= 'T') Then
//Begin
//sgBoolean := '';
Page.Add('');
//End;
End;
Page.Add('');
Page.Add('');
Page.Add(''+HTMLMetaDataTitle+'');
Page.Add('');
Page.Add('');
Page.Add('');
Page.Add('');
Page.Add(' '' Then Page.Add(' BACKGROUND="'+Background+'"');
Page.Add('>');
If URLImageTop <> '' Then Page.Add('
');
Page.Add('');
Page.Add('');
Page.Add('');
Page.Add('');
Page.Add('');
Page.Add('');
If ExecutableName = 'LOGIN.EXE' Then
Begin
Page.Add('| ');
End
Else
Begin
Page.Add(' | ');
End;
Page.Add('');
If (Trim(MainTitle) <> '') Or (Trim(SubTitle) <> '') Then
Begin
Page.Add('');
If Trim(MainTitle) <> '' Then
Begin
Page.Add('');
Page.Add('| ');
Page.Add('');
Page.Add(MainTitle);
Page.Add('');
Page.Add(' | ');
Page.Add(' ');
End;
If Trim(SubTitle) <> '' Then
Begin
Page.Add('');
Page.Add('| ');
Page.Add('');
Page.Add(SubTitle);
Page.Add('');
Page.Add(' | ');
Page.Add(' ');
End;
Page.Add('');
Page.Add(' ');
End;
Result := Page.Text;
Finally
Page.Free;
End;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function MakePageFooter: String;
Var
Page : TStringList;
ProcName : String;
Begin
ProcName := 'MakePageFooter';
Try
If Trim(HTMLPageFooter) = '' Then
Begin
Page := TStringList.Create();
Try
Page.Clear;
Page.Add('');
If (Copy(UpperCase(MeterCounterShow),1,1) = 'T') Or
(Copy(UpperCase(MeterDateShow) ,1,1) = 'T') Or
(Copy(UpperCase(MeterTimeShow) ,1,1) = 'T')
Then
Begin
Page.Add('');
Page.Add('');
If Copy(UpperCase(MeterCounterShow),1,1) = 'T' Then
Begin
Page.Add('');
Page.Add('');
Page.Add('');
Page.Add('| ');
If Copy(UpperCase(MeterCounterBold),1,1) = 'T' Then Page.Add('');
If Copy(UpperCase(MeterCounterItalics),1,1) = 'T' Then Page.Add('');
Page.Add('');
Page.Add(Counter);
Page.Add('');
If Copy(UpperCase(MeterCounterItalics),1,1) = 'T' Then Page.Add('');
If Copy(UpperCase(MeterCounterBold),1,1) = 'T' Then Page.Add('');
Page.Add(' | ');
Page.Add(' ');
Page.Add(' ');
Page.Add(' | ');
End;
If Copy(UpperCase(MeterDateShow),1,1) = 'T' Then
Begin
Page.Add('');
Page.Add('');
Page.Add('');
Page.Add('| ');
If Copy(UpperCase(MeterDateBold),1,1) = 'T' Then Page.Add('');
If Copy(UpperCase(MeterDateItalics),1,1) = 'T' Then Page.Add('');
Page.Add('');
Page.Add(FormatDateTime('mm/dd/yyyy',Now()));
Page.Add('');
If Copy(UpperCase(MeterDateItalics),1,1) = 'T' Then Page.Add('');
If Copy(UpperCase(MeterDateBold),1,1) = 'T' Then Page.Add('');
Page.Add(' | ');
Page.Add(' ');
Page.Add(' ');
Page.Add(' | ');
End;
If Copy(UpperCase(MeterTimeShow),1,1) = 'T' Then
Begin
Page.Add('');
Page.Add('');
Page.Add('');
Page.Add('| ');
If Copy(UpperCase(MeterTimeBold),1,1) = 'T' Then Page.Add('');
If Copy(UpperCase(MeterTimeItalics),1,1) = 'T' Then Page.Add('');
Page.Add('');
Page.Add(FormatDateTime('hh:nn:ss',Now()));
Page.Add('');
If Copy(UpperCase(MeterTimeItalics),1,1) = 'T' Then Page.Add('');
If Copy(UpperCase(MeterTimeBold),1,1) = 'T' Then Page.Add('');
Page.Add(' | ');
Page.Add(' ');
Page.Add(' ');
Page.Add(' | ');
End;
Page.Add(' ');
Page.Add(' ');
End;
Page.Add('');
Page.Add(' | ');
Page.Add(' ');
Page.Add(' ');
Page.Add('');
Page.Add(' | ');
Page.Add('
');
Page.Add('
');
Page.Add('');
Page.Add('');
If Copy(UpperCase(DebugDataPublish),1,1) = 'T' Then
Begin
Page.Add('');
End;
Result := Page.Text;
Finally
Page.Free;
End;
End
Else
Begin
Result := HTMLPageFooter;
End;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function ReplaceStringInString(
SourceString : String;
OldString : String;
NewString : String
): String;
Var
inPos : Integer;
ProcName : String;
Begin
ProcName := 'ReplaceStringInString';
Try
inPos := Pos(OldString,SourceString);
If inPos < 1 Then
Begin
Result := SourceString;
Exit;
End;
Result :=
Copy(SourceString,1,inPos-1)+
NewString+
Copy(
SourceString,
(inPos+Length(OldString)),
(Length(SourceString)-inPos-Length(OldString)+1));
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function MakeDBNamesPage(
ActionURL : String;
LoadBalance : String;
BufferSize : String;
lst : TStrings
): String;
var
AliasNames: TStringList;
inCounter : Integer;
ProcName : String;
Page : TStringList;
Session : TSession;
Alias : String;
begin
ProcName := 'MakeDBNamesPage';
Try
ActionURL := DeEncryptString(EncryptString(Trim(ActionURL)));
LoadBalance := EncryptString(DeEncryptString(Trim(LoadBalance)));
BufferSize := EncryptString(DeEncryptString(Trim(BufferSize)));
AliasNames := TStringList.Create();
Page := TStringList.Create();
Session := TSession.Create(nil);
Alias := lst.Values['Alias'];
AliasNames.Sorted := True;
Try
Session.SessionName := 'Session';
Page.SetText(PChar(PageHeader));
If ShouldIGenList(AliasNames) Then
Begin
With Session Do
Begin
Active := True;
GetAliasNames(AliasNames);
Active := False
End;
AliasNames.SetText(PChar(DeleteItemsFromList(AliasNames.Text)));
End;
Page.Add('' );
Page.SetText(PChar(Page.Text+MakePageFooter));
Result := Page.Text;
Finally
AliasNames.Free;
Page .Free;
Session .Free;
End
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function GetLoginID(Request : TWebRequest): String;
Var
ProcName : String;
Begin
ProcName := 'GetLoginID';
Try
If Request.MethodType = mtGet Then
Begin
Result := DeEncryptString(Request.QueryFields.Values['LoadBalance']);
End
Else
Begin
Result := DeEncryptString(Request.ContentFields.Values['LoadBalance']);
End;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function GetEncryptedLoginID(Request : TWebRequest): String;
Var
ProcName : String;
Begin
ProcName := 'GetEncryptedLoginID';
Try
If Request.MethodType = mtGet Then
Begin
Result := Request.QueryFields.Values['LoadBalance'];
End
Else
Begin
Result := Request.ContentFields.Values['LoadBalance'];
End;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function GetEncryptedPwd(Request : TWebRequest): String;
Var
ProcName : String;
Begin
ProcName := 'GetEncryptedPwd';
Try
If Request.MethodType = mtGet Then
Begin
Result := Request.QueryFields.Values['BufferSize'];
End
Else
Begin
Result := Request.ContentFields.Values['BufferSize'];
End;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function GetPwd(Request : TWebRequest): String;
Var
ProcName : String;
Begin
ProcName := 'GetPwd';
Try
If Request.MethodType = mtGet Then
Begin
Result := DeEncryptString(Request.QueryFields.Values['BufferSize']);
End
Else
Begin
Result := DeEncryptString(Request.ContentFields.Values['BufferSize']);
End;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Procedure MakeAccessDenied;
Var
lst : TStringList;
ProcName : String;
Begin
ProcName := 'MakeAccessDenied';
Try
If FileExists(ExecutablePath+'index.htm')
And
FileExists(ExecutablePath+'index.htm')
Then Exit;
lst := TStringList.Create();
Try
lst.Clear;
lst.Add('');
lst.Add('');
lst.Add('');
lst.Add('');
lst.Add('ACCESS DENIED');
lst.Add('
');
lst.Add('');
lst.Add('');
lst.Add('');
lst.SaveToFile(ExecutablePath+'index.htm');
lst.SaveToFile(ExecutablePath+'index.html');
Finally
lst.Free;
End;
Except
On E : Exception Do
Begin
ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Procedure SyncConfigParams(
var ConfigParam : String;
sgConfigParam : String);
Var
ProcName : String;
inPos : Integer;
inCounter : Integer;
Found : Boolean;
Begin
ProcName := 'SyncConfigParams';
Try
If FileExists(FileConfiguration) Then
Begin
If ConfigParams.Values[sgConfigParam]
<> ConfigParam Then
ConfigParam :=
ConfigParams.Values[sgConfigParam];
End;
Found := False;
For inCounter := 0 To ConfigParams.Count - 1 Do
Begin
inPos := Pos(UpperCase(sgConfigParam)+'=',UpperCase(ConfigParams[inCounter]));
If inPos > 0 Then
Begin
Found := True;
Break;
End;
End;
If Not Found Then ConfigParams.Add(sgConfigParam+'='+ConfigParam);
Except
On E : Exception Do
Begin
RaiseError(UnitName,ProcName,E);
ER(ProcName,'all',E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Procedure FileToStr(
Var Str : String;
FileName : String);
Var
lst : TStringList;
ProcName : String;
Begin
ProcName := 'FillStringFromFile';
Try
If FileName = '' Then Exit;
lst := TStringList.Create();
Try
lst.Clear;
If FileExists(FileName) Then
Begin
lst.LoadFromFile(FileName);
End
Else
Begin
Exit;
End;
Str := lst.Text;
Finally
lst.Free;
End;
Except
On E : Exception Do
Begin
RaiseError(UnitName,ProcName,E);
ER(ProcName,'all',E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function PageHeader: String;
Var
ProcName : String;
Begin
ProcName := 'PageHeader';
Try
If Trim(HTMLPageHeader) = '' Then
Begin
Result :=
MakePageHeader(
HTMLMetaDataTitle, //HTMLMetaDataTitle : String;
HTMLMetaDataAuthor, //HTMLMetaDataAuthor : String;
FileMetaDataKeywords, //FileMetaDataKeywords : String;
HTMLMetaDataDesc, //HTMLMetaDataDesc : String;
HTMLTitleMain, //MainTitle : String;
HTMLTitleSub, //SubTitle : String;
URLBackground, //BackGround : String;
(DebugDataPublish='TRUE')//DebugData : Boolean;
); //): String;
End
Else
Begin
Result := AdvDelphiSysComment+HTMLPageHeader;
End;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function MakeLogin: String;
Var
lst : TStringList;
ProcName : String;
begin
ProcName := 'MakeLogin';
Try
lst := TStringList.Create();
Try
lst.Clear;
lst.SetText(PChar(PageHeader));
lst.Add('');
lst.Add('');
lst.Add('| ');
lst.Add('');
lst.Add('');
lst.Add('');
lst.Add(' | ');
lst.Add('
');
lst.Add('
');
lst.SetText(PChar(lst.Text+MakePageFooter));
Result := lst.Text;
Finally
lst.Free;
End;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
End;
End;
end;
//Unit Description UnitIndex Master Index
Function DeleteItemsFromList(InputList : String): String;
Var
ProcName : String;
lstSource : TStringList;
lstDelete : TStringList;
lstOut : TStringList;
inCounter : Integer;
Begin
ProcName := 'DeleteItemsFromList';
If Trim(ListOfItemsToDelete) = '' Then
Begin
Result := InputList;
Exit;
End;
If Trim(ListOfOnlyDisplayItems) <> '' Then
Begin
Result := InputList;
Exit;
End;
Try
lstSource := TStringList.Create();
lstDelete := TStringList.Create();
lstOut := TStringList.Create();
Try
lstSource.SetText(PChar(InputList));
lstDelete.SetText(PChar(ListOfItemsToDelete));
lstOut.Clear;
For inCounter := 0 To lstSource.Count -1 Do
Begin
If lstDelete.IndexOf(lstSource[inCounter]) < 0 Then
Begin
lstOut.Add(lstSource[inCounter]);
End;
End;
Result := lstOut.Text;
Finally
lstSource.Free;
lstDelete.Free;
lstOut .Free;
End;
Except
On E : Exception Do
Begin
Result := ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function ShouldIGenList(var lst : TStringList): Boolean;
Var
ProcName : String;
Begin
ProcName := 'ShouldIGenList';
Try
lst.Clear;
If Trim(ListOfOnlyDisplayItems) <> '' Then
Begin
lst.SetText(PChar(ListOfOnlyDisplayItems));
Result := False;
End
Else
Begin
Result := True;
End;
Except
On E : Exception Do
Begin
Result := True;
ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function AdvDelphiSysComment: String;
Var
Page : TStringList;
ProcName : String;
Begin
ProcName := 'AdvDelphiSysComment';
Try
Page := TStringList.Create();
Try
Page.Clear;
Page.Add('');
Result := Page.Text;
Finally
Page.Free;
End;
Except
On E : Exception Do
Begin
Result := '';
ER(ProcName,'all',E);
RaiseError(UnitName,ProcName,E);
End;
End;
End;
//Unit Description UnitIndex Master Index
Function MakeFieldNamesPage(
ActionURL : String;
DatabaseName: String;
TableName : String;
LoadBalance : String;
BufferSize : String;
Button : String;
Values : String;
FieldValues : String
): String;
var
ChangeVisibility : Boolean;
DBName : TWebServerDB;
inCounter : Integer;
inVisNum : Integer;
inOrder : Integer;
lstValues : TStringList;
Page : TStringList;
ProcName : String;
sgVisValue : String;
sgCallingApp : String;
sgEndTag : String;
sgLineFeedTag : String;
sgReturnTag : String;
sgStartTag : String;
Table : TTable;
FC : TFieldClass;
begin
ProcName := 'MakeFieldNamesPage';
Try
sgEndTag := #201;
sgLineFeedTag := #203;
sgReturnTag := #202;
sgStartTag := #200;
BufferSize := EncryptString(DeEncryptString(Trim(BufferSize)));
ChangeVisibility := False;
DatabaseName := DeEncryptString(EncryptString(Trim(DatabaseName)));
DBName := TWebServerDB.Create(nil);
FC := TFieldClass.Create(nil);
inVisNum := -1;
LoadBalance := EncryptString(DeEncryptString(Trim(LoadBalance)));
lstValues := TStringList.Create();
Page := TStringList.Create();
Table := TTable.Create(nil);
TableName := DeEncryptString(EncryptString(Trim(TableName)));
Try
lstValues.SetText(PChar(Values));
sgCallingApp := lstValues.Values['CallingApp'];
If sgCallingApp = ExecutableName Then
Begin
ChangeVisibility := True;
Try
inVisNum := StrToInt(Button);
Except
ChangeVisibility := False;
inVisNum := -1;
End;
End;
FC.FieldValues := FieldValues;
If Not FC.Populated Then
Begin
FC.DatabaseName := DatabaseName;
FC.TableName := TableName;
End;
Page.SetText(PChar(PageHeader));
Page.Add('');
Page.Add('