ISAPI модуля на языке Delphi

ISAPI модуля на языке Delphi. unit webshopunit interface uses Windows, Messages, SysUtils, Classes, HTTPApp, DBWeb, Db, DBTables type TWebModule1 classTWebModule GroupQuery TQuery WebSession TSession StoreQTP TQueryTableProducer GroupQueryMainGroup TIntegerField GroupQuerySubGroup TIntegerField GroupQueryGroupName TStringField StoreQuery TQuery ValidateQuery TQuery AddMsgQuery TQuery procedure WebModule1GetGroupActionSender TObject Request TWebRequest Response TWebResponse var Handled Boolean procedure WebModule1CreateSender TObject procedure StoreQTPFormatCellSender TObject CellRow, CellColumn Integer var BgColor THTMLBgColor var Align THTMLAlign var VAlign THTMLVAlign var CustomAttrs, CellData String procedure WebModule1DestroySender TObject procedure WebModule1ValidateActionSender TObject Request TWebRequest Response TWebResponse var Handled Boolean procedure StoreQTPGetTableCaptionSender TObject var Caption String var Alignment THTMLCaptionAlignment procedure WebModule1AcceptOrderActionSender TObject Request TWebRequest Response TWebResponse var Handled Boolean procedure WebModule1SearchActionSender TObject Request TWebRequest Response TWebResponse var Handled Boolean procedure WebModule1AddMSgActionSender TObject Request TWebRequest Response TWebResponse var Handled Boolean private ScriptName String Private declarations public Public declarations function GroupListProducerQuery TQuery Kind Integer string function CreateGroupListGr1,Gr2,KindInteger string end var WebModule1 TWebModule1 resourcestring sOrderAccepted Tр чрърч яхэю яшэ sContent уыртыхэшх implementation uses inifiles R .DFM var HTMLPath, TemplatesPath, DBAliasName, iniName,CommonLook,CommonEnd string UserStatus Integer csect TRTLCriticalSection procedure TWebModule1.WebModule1CreateSender TObject var ini TINIFile FN array0 MAXPATH- 1 of char s1,s2 string fs TFileStream bgpath, txtcol, lcol, vcol, acol string begin GetWindowsDirectoryFN, SizeOfFN s1 StrPasfn GetModuleFileNamehInstance, FN, SizeOfFN s2 ExtractFileNameStrPasfn if not Chars1Lengths1 in, then AppendStrs1, if Pos s2 0 then s2 Copys2,1,Pos s2-1 iniName s1s2.ini ini TINIFile. CreateiniName HTMLPath ini. ReadStringPaths,HTMLPath, test TemplatesPath ini. ReadStringPaths,TemplatesPath, s1 DBAliasName ini. ReadStringPaths,DBAliasName, webtest if AssignedWebSession and WebSession. IsAliasDBAliasName then begin GroupQuery. DatabaseName DBAliasName StoreQuery. DatabaseName DBAliasName ValidateQuery. DatabaseName DBAliasName end bgpath ini. ReadStringDesign,Background, imgsand. jpg txtcol ini. ReadStringDesign, text, black lcol ini. ReadStringDesign, link, blue acol ini. ReadStringDesign, alink, aqua vcol ini. ReadStringDesign, vlink, aqua ini. Free CommonLook Format HTML BODY BACKGROUNDss TEXTs LINKs ALINKs VLINKs , HTMLPath, bgpath, txtcol, lcol, acol, vcol CommonEnd BODY HTML end procedure TWebModule1.WebModule1DestroySender TObject begin end function TWebModule1.GroupListProducerQuery TQuery kind Integer string var s stringgn1,gn2 Integer begin with Query do try Open Result First while not Eof do begin gn1 Query. Fields0.AsInteger gn2 Query. Fields1.AsInteger if Gn20 then s else sIntToStrGn2 Result Result Format A HREFsGetGroupGr1dGr2dKindd d.s s A BR , Request. ScriptName, gn1,gn2,Kind, gn1,s,Query. Fields2.AsString Next end finally Close end end function TWebModule1.CreateGroupListGr1,Gr2,KindI nteger string var fs TFileStream i Integer begin Result B FONT SIZE1 sContent BR FONT B HR with GroupQuery do begin if Gr10 then SQL.Text SELECT FROM Groups WHERE SubGroup0 else SQL.Text FormatSELECT FROM Groups WHERE MainGroupd and SubGroup 0,Gr1 try Result Result GroupListProducerGroupQuery,Kind if Gr1 0 then Result Result Format A HREFsGetGroupGr1dGr2dKindd Tхэ ъ юуыртыхэш A BR , Request. ScriptName, 0,0, Kind except on EEDBEngineError do begin Result Result шсър BDE BR for i0 to E.ErrorCount -1 do Result Result E.Errorsi. Message BR end end end Result Result HR a hrefhttpRequest. HostHTMLPathsearch.htm юшъ A CommonEnd end QueryAction - GetGroup тvтюф рсышv яю ют.уяях threadvar OperKind Integer procedure TWebModule1.WebModule1GetGroupActionSend er TObject Request TWebRequest Response TWebResponse var Handled Boolean var gn1,gn2 Integer OrderCol THTMLTableColumn begin with Request. QueryFields do begin gn1 IndexOfNameKind if gn1 0 then OperKind StrToIntDefValuesKind,0 if gn1 0 then Deletegn1 gn1 StrToIntDefValuesGr1,0 gn2 StrToIntDefValuesGr2,0 end with if gn10 then Response. Content CommonLookCreateGroupListgn1,gn2,OperKin d else if gn20 then Response. Content CommonLookCreateGroupListgn1,gn2,OperKin d else begin define group name with GroupQuery do begin SQL.Text SELECT FROM Groups WHERE MainGroupgn1 and SubGroupgn2 Params0.AsInteger gn1 Params1.AsInteger gn2 Open with StoreQTP do begin Header. Clear Header. AddCommonLook if OperKind 0 then begin OrderCol THTMLTableColumn. CreateStoreQTP.Columns OrderCol. Title. Caption рърч end else OrderCol nil case OperKind of 1 Header. Add FORM METHODGET ACTIONRequest. ScriptNameAcceptOrder 2 Header. Add FORM METHODGET ACTIONRequest. ScriptNameEditPrice endcase Header. Add BR рхуюш I FieldByNameGroupName. AsString I BR Close Footer. Clear if OperKind1 then Footer. Add BR Tюъ юяырv INPUT TYPETEXT NAMEWHENPAY VALUE if OperKind 0 then begin Footer. Add INPUT TYPESUBMIT VALUEOK INPUT TYPERESET VALUEьхэр FORM end Footer. AddFormat A HREFsGetGroupGr1dGr2dKindd Tхэ ъ юуыртыхэш A BR , Request. ScriptName, gn1,0, OperKind endwith storeqtp endwith groupquery Response. Content StoreQTP.Content if AssignedOrderCol then OrderCol. Free end generating table end procedure TWebModule1.StoreQTPFormatCellSender TObject CellRow, CellColumn Integer var BgColor THTMLBgColor var Align THTMLAlign var VAlign THTMLVAlign var CustomAttrs, CellData String var s string begin if CellRow 0 then if CellRow mod 20 then BgColorsilver else BgColorGray if OperKind 0 and CellColumn0 and CellRow 0 then begin CellData INPUT TYPEHIDDEN NAMEHIntToStrCellRow VALUECellData CellData end if OperKind 0 and CellColumnStoreQTP.Columns. Count-1 and CellRow 0 then begin CellData INPUT TYPECHECKBOX NAMERIntToStrCellRow VALUE1 рърчр s BR INPUT TYPETEXT NAMETIntToStrCellRow SIZE5 MAXLENGTH8 VALUE CellData CellDatas end end procedure TWebModule1.StoreQTPGetTableCaptionSende r TObject var Caption String var Alignment THTMLCaptionAlignment begin Caption рщфхэю чряшхщ IntToStrStoreQTP.Query. RecordCount end procedure TWebModule1.WebModule1ValidateActionSend er TObject Request TWebRequest Response TWebResponse var Handled Boolean begin with ValidateQuery do begin Params0.AsString Request. QueryFields. ValuesUserName Params1.AsString Request. QueryFields. ValuesPassword try Open if RecordCount 0 then begin UserStatus FieldByNameUserCategory. AsInteger Response.

Content CommonLook BR B Tv яхэю чрхушшютрэv B if UserStatus 0 then Response. Content Response. Content BR Tvсхшх ютрэ уяя ш ттхфшх чрърч BR CreateGroupList0,0,1 else begin Response. Content Response. Content BR T ърхтх рфьшэшрюр BR a hrefhttpRequest. HostHTMLPathadmmenu.htm B Tрэшр рфьшэшрюр B A end end else Response. Content CommonLookTрш фрээvх ют т срчх. сршх ъ эрь яю рфх xxxyyy.zzz finally Close end end end procedure TWebModule1.WebModule1AcceptOrderActionS ender TObject Request TWebRequest Response TWebResponse var Handled Boolean begin Response. Content CommonLooksOrderAcceptedCommonEnd -рых тртх тющ ъюф фы тъыхэш чрърчр т срч end procedure TWebModule1.WebModule1SearchActionSender TObject Request TWebRequest Response TWebResponse var Handled Boolean var s string begin s Request. QueryFields. ValuesPhrase GroupQuery. SQL.Text SELECT FROM Groups WHERE GroupName LIKE s Response. Content CommonLook BR хчырv яюшър I s I BR GroupListProducerGroupQuery,0CommonEnd end procedure TWebModule1.WebModule1AddMSgActionSender TObject Request TWebRequest Response TWebResponse var Handled Boolean var MCookies TStringListi integer begin Response. Content CommonLook with AddMsgQuery do try Params0.AsStringRequest. QueryFields. Valu esSender Params1.AsStringRequest. Host Params2.AsDateTimeRequest. Date Params3.AsMemoRequest. QueryFields. Values Message Prepare ExecSQL MCookies TStringList. Create MCookies. AddUserRequest. PathTranslated MCookies. AddTestRequest. RemoteHost MCookies. AddTimeRequest. UserAgent Response. SetCookieFieldMCookies Request. PathInfo , Date1, False MCookies. Free Response. Content Response. Content Tрх ююс хэшх яшэ ю CommonEnd except on EEDBEngineError do begin Response. Content Response. Content шсър BDE BR for i0 to E.ErrorCount -1 do Response. Content Response. Content E.Errorsi. Message BR Response. Content Response. Content CommonEnd end end end end.