HTML и базы данных — страница 10

  • Просмотров 6727
  • Скачиваний 438
  • Размер файла 164

procedure WebModule1AddMSgAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); private ScriptName: String; { Private declarations } public { Public declarations } function GroupListProducer(Query: TQuery; Kind: Integer): string; function CreateGroupList(Gr1,Gr2,Kind:Integer) : 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.WebModule1Create(Sender: TObject); var ini : TINIFile; FN: array[0..MAX_PATH- 1] of char; s1,s2: string; fs :

TFileStream; bgpath, txtcol, lcol,vcol,acol: string; begin GetWindowsDirectory(FN, SizeOf(FN)); s1:= StrPas(fn); GetModuleFileName(hInstance, FN, SizeOf(FN)); s2 := ExtractFileName(StrPas(fn)); if not (Char(s1[Length(s1)]) in ['/','\']) then AppendStr(s1,'/'); if Pos('.',s2)<>0 then s2 := Copy(s2,1,Pos('.',s2)-1); iniName := s1+s2+'.ini'; ini := TINIFile.Create(iniName); HTMLPath := ini.ReadString('Paths','HTMLPath','/test'); TemplatesPath := ini.ReadString('Paths','TemplatesPath',s1); DBAliasName := ini.ReadString('Paths','DBAliasName','webtest'); if Assigned(WebSession) and WebSession.IsAlias(DBAliasName) then begin GroupQuery.DatabaseName := DBAliasName; StoreQuery.DatabaseName := DBAliasName; ValidateQuery.DatabaseName := DBAliasName; end; bgpath :=

ini.ReadString('Design','Background','img\sand.jpg'); txtcol := ini.ReadString('Design','text','black'); lcol := ini.ReadString('Design','link','blue'); acol := ini.ReadString('Design','alink','aqua'); vcol := ini.ReadString('Design','vlink','aqua'); ini.Free; CommonLook := Format('<HTML><BODY BACKGROUND="%s%s" TEXT=%s LINK=%s ALINK=%s VLINK=%s>', [HTMLPath,bgpath,txtcol,lcol,acol,vcol]); CommonEnd := '</BODY></HTML>'; end; procedure TWebModule1.WebModule1Destroy(Sender: TObject); begin ; end; function TWebModule1.GroupListProducer(Query: TQuery; kind: Integer): string; var s: string;gn1,gn2: Integer; begin with Query do try Open; Result := ''; First; while not Eof do begin gn1 := Query.Fields[0].AsInteger; gn2 := Query.Fields[1].AsInteger; if

Gn2=0 then s:='' else s:=IntToStr(Gn2); Result := Result + Format('<A HREF="%s/GetGroup?Gr1=%d&Gr2=%d&Kind=%d">%d.%s %s</A><BR>', [Request.ScriptName, gn1,gn2,Kind, gn1,s,Query.Fields[2].AsString]); Next; end; finally Close; end; end; function TWebModule1.CreateGroupList(Gr1,Gr2,Kind:Integer) : string; var fs: TFileStream; i: Integer; begin Result := '<B><FONT SIZE=+1>'+sContent+'<BR></FONT></B><HR>'; with GroupQuery do begin if Gr1=0 then SQL.Text := 'SELECT * FROM Groups WHERE SubGroup=0' else SQL.Text := Format('SELECT * FROM Groups WHERE (MainGroup=%d) and (SubGroup>0)',[Gr1]); try Result := Result + GroupListProducer(GroupQuery,Kind); if Gr1<>0 then Result := Result + Format('<A

HREF="%s/GetGroup?Gr1=%d&Gr2=%d&Kind=%d">TхЁэєЄ№ё  ъ юуыртыхэш¦</A><BR>', [Request.ScriptName, 0,0, Kind]); except on E:EDBEngineError do begin Result := Result + '+°шсър BDE'+'<BR>'; for i:=0 to E.ErrorCount -1 do Result := Result + E.Errors[i].Message + '<BR>'; end; end; end; Result := Result+'<HR><a href="http://'+Request.Host+HTMLPath+'/search.htm">¦юшёъ</A>' +CommonEnd; end; // QueryAction - GetGroup тvтюф ЄрсышЎv яю Єют.уЁєяях threadvar OperKind : Integer; procedure TWebModule1.WebModule1GetGroupAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); var gn1,gn2 : Integer; OrderCol : THTMLTableColumn; begin with

Request.QueryFields do begin gn1 := IndexOfName('Kind'); if (gn1<>0) then OperKind := StrToIntDef(Values['Kind'],0); if gn1>=0 then Delete(gn1); gn1 := StrToIntDef(Values['Gr1'],0); gn2 := StrToIntDef(Values['Gr2'],0); end; //with if gn1=0 then Response.Content := CommonLook+CreateGroupList(gn1,gn2,OperKind) else if gn2=0 then Response.Content := CommonLook+CreateGroupList(gn1,gn2,OperKind) else begin //define group name with GroupQuery do begin SQL.Text := 'SELECT * FROM Groups WHERE (MainGroup=:gn1) and (SubGroup=:gn2)'; Params[0].AsInteger := gn1; Params[1].AsInteger := gn2; Open; with StoreQTP do begin Header.Clear; Header.Add(CommonLook); if OperKind>0 then begin OrderCol := THTMLTableColumn.Create(StoreQTP.Columns); OrderCol.Title.Caption := '¦рърч'; end