Bu unit program "webserver 2" işleminde kullanılır.
Kod: Tümünü seç
unit ads_wbServer;
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';
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;
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;
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;
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;
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 :=
'<HTML>'+
'<BODY>'+
'<CENTER>'+
'<P>'+
'<H1>ERROR MESSAGE</H1>'+
'<BR>'+
sgRec+
'</BODY>'+
'</HTML>';
If ErrorsSaveToFile = 'TRUE' Then Errors.Add(sgRec);
End;
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;
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 := '<TABLE>';
TableEnd := '</TABLE>';
RowStart := '<TR>';
RowEnd := '</TR>';
CellStart := '<TD>';
CellEnd := '</TD>';
End
Else
Begin
CommentStart := '<!-- ';
CommentEnd := ' -->';
TableStart := '';
TableEnd := '';
RowStart := '';
RowEnd := '';
CellStart := '';
CellEnd := '';
End;
lst := TStringList.Create;
Try
With lst Do
Begin
Clear;
Add(CommentStart+'<P>'+CommentEnd);
Add(CommentStart+'Requestor Data'+CommentEnd);
Add(CommentStart+'<BR>'+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;
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;
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;
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;
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('<TABLE>');
Page.Add('<TR>');
Page.Add('<TD COLSPAN=2 ALIGN=CENTER>');
Page.Add('<FONT SIZE='+HTMLTableFontSize+' COLOR="'+HTMLTableColorFont+'">');
Page.Add(DatabaseName+' Database');
Page.Add('</FONT>');
Page.Add('</TD>');
Page.Add('</TR>');
Page.Add('<TR>');
Page.Add('<TD COLSPAN=2 ALIGN=CENTER>');
Page.Add('<FONT SIZE='+HTMLTableFontSize+' COLOR="'+HTMLTableColorFont+'">');
Page.Add('Please select a database table.');
Page.Add('</FONT>');
Page.Add('</TD>');
Page.Add('</TR>');
Page.Add('<TR>');
//Page.Add('<TR>');
//Page.Add('<TD COLSPAN=2 ALIGN=CENTER>');
Page.Add('<TD>');
Page.Add('<FORM ACTION="'+URLScriptDir+'alias.exe" METHOD=POST>');
Page.Add('<INPUT TYPE="HIDDEN" NAME="LoadBalance" VALUE="'+LoadBalance +'">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="BufferSize" VALUE="'+BufferSize +'">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="Alias" VALUE="'+DatabaseName+'">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="Table" VALUE="">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="Role" VALUE="">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="RecNo" VALUE="">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="RecMax" VALUE="">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="CallingApp" VALUE="'+ExecutableName+'">');
Page.Add('<INPUT TYPE="SUBMIT" NAME="SUBMIT" VALUE="DB">');
Page.Add('</TD>');
Page.Add('</FORM>');
Page.Add('<TD>');
//Page.Add('<TD COLSPAN=2 ALIGN=CENTER>');
//Page.Add('<FORM ACTION="'+ActionURL+'" METHOD=POST>');
Page.Add('<FORM ACTION="'+URLScriptDir+'Browse.exe" METHOD=POST>');
Page.Add('<INPUT TYPE="HIDDEN" NAME="LoadBalance" VALUE="'+LoadBalance +'">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="BufferSize" VALUE="'+BufferSize +'">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="Alias" VALUE="'+DatabaseName+'">');
//Page.Add('<INPUT TYPE="HIDDEN" NAME="Table" VALUE="'+TableName +'">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="Role" VALUE="">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="RecNo" VALUE="">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="RecMax" VALUE="">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="CallingApp" VALUE="'+ExecutableName+'">');
Page.Add('<SELECT NAME="table">');
For i:=0 To TableNames.Count - 1 Do
Begin
If TableNames[i] = TableName Then
Begin
Page.Add('<OPTION SELECTED VALUE="'+TableNames[i]+'">'+TableNames[i]);
End
Else
Begin
Page.Add('<OPTION VALUE="'+TableNames[i]+'">'+TableNames[i]);
End;
End;
Page.Add('</SELECT>');
Page.Add('<INPUT TYPE="SUBMIT" NAME="SUBMIT" VALUE="View">');
Page.Add('</TD>');
Page.Add('</FORM>');
Page.Add('</TR>');
Page.Add('</TABLE>');
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;
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('Developer: Richard Maley');
Page.Add('Advanced Delphi Systems');
Page.Add('http://www.advdelphisys.com');
Page.Add('phone: 301-840-1554');
Page.Add('12613 Maidens Bower Drive');
Page.Add('Potomac, Maryland, 20854 USA');
Page.Add('-->');
Page.Add('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"');
Page.Add('"http://www.w3.org/TR/REC-html40/loose.dtd">');
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('<!-- ');
Page.Add('<HTML>');
Page.Add('<BODY>');
Page.Add('ERROR: CORRUPTED SOURCE');
Page.Add('</BODY>');
Page.Add('</HTML>');
For inCounter := 0 To 100 Do
Begin
sgBoolean := sgBoolean + HTMLHideString;
Page.Add('');
End;
Page.Add(' -->');
//End;
End;
Page.Add('<HTML>');
Page.Add('<HEAD>');
Page.Add('<TITLE>'+HTMLMetaDataTitle+'</TITLE>');
Page.Add('<META NAME="Author" CONTENT="'+HTMLMetaDataAuthor+'">');
Page.Add('<META NAME="keywords" CONTENT="'+FileMetaDataKeywords+'">');
Page.Add('<META NAME="description" CONTENT="'+HTMLMetaDataDesc+'">');
Page.Add('</HEAD>');
Page.Add('<BODY');
If Background <> '' Then Page.Add(' BACKGROUND="'+Background+'"');
Page.Add('>');
If URLImageTop <> '' Then Page.Add('<IMG SRC="'+URLImageTop+'">');
Page.Add('<TABLE WIDTH="100%" HEIGHT="100%">');
Page.Add('<TR VALIGN="CENTER">');
Page.Add('<TD>');
Page.Add('<CENTER>');
Page.Add('<TABLE BORDER');
Page.Add('CELLSPACING="'+HTMLTableCellSpacing+'"');
Page.Add('BORDERCOLOR="'+HTMLTableColorBorder+'"');
Page.Add('CELLPADDING="'+HTMLTableCellPadding+'"');
Page.Add('>');
Page.Add('<TR VALIGN="CENTER">');
If ExecutableName = 'LOGIN.EXE' Then
Begin
Page.Add('<TD BGCOLOR="#C0C0C0">');
End
Else
Begin
Page.Add('<TD BGCOLOR="'+HTMLTableColorBackGrd +'">');
End;
Page.Add('<CENTER>');
If (Trim(MainTitle) <> '') Or (Trim(SubTitle) <> '') Then
Begin
Page.Add('<TABLE>');
If Trim(MainTitle) <> '' Then
Begin
Page.Add('<TR ALIGN="CENTER">');
Page.Add('<TD>');
Page.Add('<FONT SIZE='+HTMLTitleMainSize+' COLOR="'+HTMLTitleMainColor+'"><B>');
Page.Add(MainTitle);
Page.Add('</B></FONT>');
Page.Add('</TD>');
Page.Add('</TR>');
End;
If Trim(SubTitle) <> '' Then
Begin
Page.Add('<TR ALIGN="CENTER">');
Page.Add('<TD>');
Page.Add('<FONT SIZE='+HTMLTitleSubSize+' COLOR="'+HTMLTitleSubColor+'"><B>');
Page.Add(SubTitle);
Page.Add('</B></FONT>');
Page.Add('</TD>');
Page.Add('</TR>');
End;
Page.Add('<!-- PAGE HEADER ENDS HERE -->');
Page.Add('</TABLE>');
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;
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('<!-- PAGE FOOTER STARTS HERE -->');
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('<TABLE BORDER');
Page.Add('CELLSPACING="'+HTMLTableCellSpacing+'"');
//Page.Add('BORDERCOLOR="'+HTMLTableColorBorder+'"');
Page.Add('BORDERCOLOR="'+HTMLTableColorBackGrd+'"');
Page.Add('CELLPADDING="'+HTMLTableCellPadding+'"');
Page.Add('WIDTH="100%"');
Page.Add('>');
Page.Add('<TR VALIGN="TOP" ALIGN="CENTER">');
If Copy(UpperCase(MeterCounterShow),1,1) = 'T' Then
Begin
Page.Add('<TD BGCOLOR="'+HTMLTableColorBackGrd +'">');
Page.Add('<TABLE BORDER CELLSPACING="1" BORDERCOLOR="'+MeterCounterColorBorder+'" CELLPADDING="7" WIDTH="50">');
Page.Add('<TR>');
Page.Add('<TD BGCOLOR="'+MeterCounterColorBackGrd+'">');
If Copy(UpperCase(MeterCounterBold),1,1) = 'T' Then Page.Add('<B>');
If Copy(UpperCase(MeterCounterItalics),1,1) = 'T' Then Page.Add('<I>');
Page.Add('<FONT ');
Page.Add('SIZE="2"');
Page.Add('SIZE="'+MeterCounterFontSize+'"');
Page.Add('COLOR="'+MeterCounterColorFont+'">');
Page.Add(Counter);
Page.Add('</FONT>');
If Copy(UpperCase(MeterCounterItalics),1,1) = 'T' Then Page.Add('</I>');
If Copy(UpperCase(MeterCounterBold),1,1) = 'T' Then Page.Add('</B>');
Page.Add('</TD>');
Page.Add('</TR>');
Page.Add('</TABLE>');
Page.Add('</TD>');
End;
If Copy(UpperCase(MeterDateShow),1,1) = 'T' Then
Begin
Page.Add('<TD BGCOLOR="'+HTMLTableColorBackGrd +'">');
Page.Add('<TABLE BORDER CELLSPACING="1" BORDERCOLOR="'+MeterDateColorBorder+'" CELLPADDING="7" WIDTH="50">');
Page.Add('<TR>');
Page.Add('<TD BGCOLOR="'+MeterDateColorBackGrd+'">');
If Copy(UpperCase(MeterDateBold),1,1) = 'T' Then Page.Add('<B>');
If Copy(UpperCase(MeterDateItalics),1,1) = 'T' Then Page.Add('<I>');
Page.Add('<FONT ');
Page.Add('SIZE="2"');
Page.Add('SIZE="'+MeterDateFontSize+'"');
Page.Add('COLOR="'+MeterDateColorFont+'">');
Page.Add(FormatDateTime('mm/dd/yyyy',Now()));
Page.Add('</FONT>');
If Copy(UpperCase(MeterDateItalics),1,1) = 'T' Then Page.Add('</I>');
If Copy(UpperCase(MeterDateBold),1,1) = 'T' Then Page.Add('</B>');
Page.Add('</TD>');
Page.Add('</TR>');
Page.Add('</TABLE>');
Page.Add('</TD>');
End;
If Copy(UpperCase(MeterTimeShow),1,1) = 'T' Then
Begin
Page.Add('<TD BGCOLOR="'+HTMLTableColorBackGrd +'">');
Page.Add('<TABLE BORDER CELLSPACING="1" BORDERCOLOR="'+MeterTimeColorBorder+'" CELLPADDING="7" WIDTH="50">');
Page.Add('<TR>');
Page.Add('<TD BGCOLOR="'+MeterTimeColorBackGrd+'">');
If Copy(UpperCase(MeterTimeBold),1,1) = 'T' Then Page.Add('<B>');
If Copy(UpperCase(MeterTimeItalics),1,1) = 'T' Then Page.Add('<I>');
Page.Add('<FONT ');
Page.Add('SIZE="2"');
Page.Add('SIZE="'+MeterTimeFontSize+'"');
Page.Add('COLOR="'+MeterTimeColorFont+'">');
Page.Add(FormatDateTime('hh:nn:ss',Now()));
Page.Add('</FONT>');
If Copy(UpperCase(MeterTimeItalics),1,1) = 'T' Then Page.Add('</I>');
If Copy(UpperCase(MeterTimeBold),1,1) = 'T' Then Page.Add('</B>');
Page.Add('</TD>');
Page.Add('</TR>');
Page.Add('</TABLE>');
Page.Add('</TD>');
End;
Page.Add('</TR>');
Page.Add('</TABLE>');
End;
Page.Add('</CENTER>');
Page.Add('</TD>');
Page.Add('</TR>');
Page.Add('</TABLE>');
Page.Add('</CENTER>');
Page.Add('</TD>');
Page.Add('</TR>');
Page.Add('</TABLE>');
Page.Add('</BODY>');
Page.Add('</HTML>');
If Copy(UpperCase(DebugDataPublish),1,1) = 'T' Then
Begin
Page.Add('<!-- PlaceDebugDataHere -->');
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;
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;
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('<FORM ACTION="'+ActionURL+'" METHOD=POST>');
Page.Add('<INPUT TYPE="HIDDEN" NAME="LoadBalance" VALUE="'+LoadBalance +'">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="BufferSize" VALUE="'+BufferSize +'">');
//Page.Add('<INPUT TYPE="HIDDEN" NAME="Alias" VALUE="'+DatabaseName+'">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="Table" VALUE="">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="Role" VALUE="">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="RecNo" VALUE="">');
Page.Add('<INPUT TYPE="HIDDEN" NAME="RecMax" VALUE="">');
Page.Add('<TABLE>');
Page.Add('<TR>');
Page.Add('<TD COLSPAN=2 ALIGN=CENTER>');
Page.Add('<FONT SIZE='+HTMLTableFontSize+' COLOR="'+HTMLTableColorFont+'">');
Page.Add('Database Selection');
Page.Add('</FONT>');
Page.Add('</TD>');
Page.Add('</TR>');
Page.Add('<TR>');
Page.Add('<TD COLSPAN=2 ALIGN=CENTER>');
Page.Add('<FONT SIZE='+HTMLTableFontSize+' COLOR="'+HTMLTableColorFont+'">');
Page.Add('Please select a database.');
Page.Add('</FONT>');
Page.Add('</TD>');
Page.Add('</TR>');
If (DBLoadDatabaseName = 'TRUE') And (DBValueDatabaseName <> '') Then
Begin
Page.Add('<TR><TD COLSPAN=2 ALIGN=CENTER><SELECT NAME="alias">');
Page.Add('<OPTION SELECTED VALUE="'+DBValueDatabaseName+'">'+DBValueDatabaseName);
Page.Add('</SELECT>');
End
Else
Begin
Page.Add('<TR><TD COLSPAN=2 ALIGN=CENTER><SELECT NAME="alias">');
For inCounter:=0 To AliasNames.Count - 1 Do
Begin
If Alias = AliasNames[inCounter] Then
Begin
Page.Add('<OPTION SELECTED VALUE="'+AliasNames[inCounter]+'">'+AliasNames[inCounter]);
End
Else
Begin
Page.Add('<OPTION VALUE="'+AliasNames[inCounter]+'">'+AliasNames[inCounter]);
End;
End;
Page.Add('</SELECT>');
End;
Page.Add('<INPUT TYPE="SUBMIT" NAME="SUBMIT" VALUE="Next">');
Page.Add('</TD></TR>');
Page.Add('</TABLE>' );
Page.Add('</FORM>' );
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;
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;
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;
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;
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;
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('<HTML>');
lst.Add('<BODY>');
lst.Add('<CENTER>');
lst.Add('<H1>');
lst.Add('ACCESS DENIED');
lst.Add('</H1>');
lst.Add('</CENTER>');
lst.Add('</BODY>');
lst.Add('</HTML>');
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;
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;
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;
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;
Function MakeLogin: String;
Var
lst : TStringList;
ProcName : String;
begin
ProcName := 'MakeLogin';
Try
lst := TStringList.Create();
Try
lst.Clear;
lst.SetText(PChar(PageHeader));
lst.Add('<table width="100%" height="100%">');
lst.Add('<tr valign="center">');
lst.Add('<td>');
lst.Add('<center>');
lst.Add('<FORM METHOD="POST" ACTION="/scripts/Login.exe/Login">');
lst.Add(' <table border="0" cellpadding="0"