unit whsample_BrowserInformation; {browser information} (* Copyright (c) 1995-2004 HREF Tools Corp. Permission is hereby granted, on 26-Nov-2004, free of charge, to any person obtaining a copy of this file (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. *) { --------------------------------------------------------------------------- } { As of 26-Nov-2004 and WebHub v2.040, this unit is no longer used in WebHub. } { --------------------------------------------------------------------------- } interface uses Windows, Dialogs, Classes, SysUtils, WebLink, WebStLst; // for example... pWebApp.WebOutput.Browser.MozLevel type TwhBrowserInfo = class(TWebAction) private fMake, fModel, fMajor, fMinor, fMozMajor, fMozMinor, fLanguage, fOS, fProxy: String; // fCapabilities: TWebStoreList; fBrowsers: TWebStoreList; fUserAgent: string; fDoSaveState: Boolean; fActiveXControls: boolean; fAK: boolean; fAOL: boolean; fBackgroundSounds: boolean; fBeta: boolean; fCDF: boolean; fCookies: boolean; fCrawler: boolean; fFrames: boolean; fJavaApplets: boolean; fJavaScript: boolean; fSK: boolean; fTables: boolean; fVBScript: boolean; fWin16: boolean; // procedure SetUserAgent(const Value: string); procedure SetIniSection(const Value: string); function GetIniSection: string; // function GetShortName: string; //model + major version function GetShortName2: string; //model + major +'.'+ minor version function GetMozLevel: string; //moxmajor + '.'+ mozminor // function GetBrowser: string; function GetPlatform: string; function GetVersionString: string; // function GetExpireWithPragmaNocache: Boolean; function GetAnchorInQueryString: Boolean; function GetUserAgentHash: String; // protected procedure SetSaveState(const State:String); override; function GetSaveState:String; override; // function GetIniFileName:String; procedure SetIniFileName(const Value: string); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Refresh: Boolean; override; function DoUpdate: Boolean; override; procedure Execute; override; published //lists property Browsers: TWebStoreList read fBrowsers; property Capabilities: TWebStoreList read fCapabilities; //input property property UserAgent: string read fUserAgent write SetUserAgent stored false; //hash value of the useragent -- used by to determine if surfer changed browsers property UserAgentHash: String read GetUserAgentHash write SetNoString stored false; //output properties derived exclusively from the user agent string analysis property Make: String read fMake write fMake stored false; property Model: String read fModel write fModel stored false; property Major: String read fMajor write fMajor stored false; property Minor: String read fMinor write fMinor stored false; property Language: String read fLanguage write fLanguage stored false; property OS: String read fOS write fOS stored false; property Proxy: String read fProxy write fProxy stored false; //moz levels are often claimed/given in addition to the browsers own version# property MozMajor: String read fMozMajor write fMozMajor stored false; property MozMinor: String read fMozMinor write fMozMinor stored false; //properties based on functions based on the user agent analysis property AnchorInQueryString: Boolean read GetAnchorInQueryString; property ExpireWithPragmaNocache: Boolean read GetExpireWithPragmaNocache; //property aol.. // :-false, uc-true //combinations of user agent elements for comparison from webhub html property ShortName: string read GetShortName write SetNoString; property ShortName2: string read GetShortName2 write SetNoString; property MozLevel: string read GetMozLevel write SetNoString; //support for ms's browser capabilities file //browser capabilities file property IniFileName: string read GetIniFileName write SetIniFileName stored false; //ini file section last read for browser capabilities et all property IniSection: string read GetIniSection write SetIniSection stored false; //common string elements from the capabilities array. //read onNewsession and when the component is reset. property Browser: string read GetBrowser write SetNoString; property Platform: string read GetPlatform write SetNoString; property VersionString: string read GetVersionString write SetNoString; //(property AuthenticodeUpdate: CHAR? 'a') //are we saving the browser capability flags per surfer property DoSaveState: Boolean read fDoSaveState write fDoSaveState default true; //turn off DOSAVESTATE if you need only grab a few properties on newsessions. //if true, do savestate saves the boolean properties below here: //capability flags extracted from the browser version capabilities array property ActiveXControls: boolean read fActiveXControls write SetNoBoolean stored false; property AK: boolean read fAK write SetNoBoolean stored false; property AOL: boolean read fAOL write SetNoBoolean stored false; property BackgroundSounds: boolean read fBackgroundSounds write SetNoBoolean stored false; property Beta: boolean read fBeta write SetNoBoolean stored false; property CDF: boolean read fCDF write SetNoBoolean stored false; property Cookies: boolean read fCookies write SetNoBoolean stored false; property Crawler: boolean read fCrawler write SetNoBoolean stored false; property Frames: boolean read fFrames write SetNoBoolean stored false; property JavaApplets: boolean read fJavaApplets write SetNoBoolean stored false; property JavaScript: boolean read fJavaScript write SetNoBoolean stored false; property SK: boolean read fSK write SetNoBoolean stored false; property Tables: boolean read fTables write SetNoBoolean stored false; property VBScript: boolean read fVBScript write SetNoBoolean stored false; property Win16: boolean read fWin16 write SetNoBoolean stored false; end; implementation uses IniFiles, whsample_UserAgent, WebInfou, IniLink, ucWinApi, ucString, ucInteg {$IFDEF Log2File}, ucLogFil{$ENDIF} ; const cDefaultBrowserSection = 'Default Browser Capability Settings'; cFileDoesNotExist = '(File Does Not Exist)'; cEq = '='; constructor TwhBrowserInfo.Create(AOwner: TComponent); begin inherited create(AOwner); fBrowsers:= TWebStoreList.create; fCapabilities:= TWebStoreList.create; fDoSaveState:= true; end; destructor TwhBrowserInfo.Destroy; begin fBrowsers.free; fCapabilities.free; inherited destroy; end; // function TwhBrowserInfo.GetAnchorInQueryString:Boolean; begin if (Make='Mozilla') and (Major='3') then Result := False else Result := True; end; function TwhBrowserInfo.GetExpireWithPragmaNocache: Boolean; begin Result:= (Make='MSIE') and (Major<>'4'); end; function TwhbrowserInfo.GetUserAgentHash:String; begin Result:= IntToHex(htHashString(fUserAgent),4); end; // function TwhBrowserInfo.GetIniFileName:String; begin Result:=fIniFileName; if (Result='') or not FileExists(Result) then begin Result:=Classname; delete(Result,1,1); Result:=WebInfou.WebInfo.WebDefault[Result+'.IniFileName']; if FileExists(Result) then SetIniFileName(Result); end; end; procedure TwhBrowserInfo.SetIniFileName(const Value: string); begin inherited SetIniFileName(Value); fBrowsers.Clear; Update; end; procedure TwhBrowserInfo.SetUserAgent(const Value: string); begin // if (value<>fUserAgent) then begin fUserAgent:= value; DoUpdate; // end; end; procedure TwhBrowserInfo.SetIniSection(const Value: string); begin end; function TwhBrowserInfo.GetIniSection: string; var i: integer; procedure ReadSections(ini: TIniFile; Strings: TStrings); const BufSize = 64*1024; //make room for LOTS of sections. var Buffer, P: PChar; begin GetMem(Buffer, BufSize); try Strings.BeginUpdate; try Strings.Clear; if GetPrivateProfileString(nil, nil, nil, Buffer, BufSize, PChar(ini.FileName)) <> 0 then begin P := Buffer; while P^ <> #0 do begin Strings.Add(P); Inc(P, StrLen(P) + 1); end; end; finally Strings.EndUpdate; end; finally FreeMem(Buffer, BufSize); end; end; begin with fBrowsers do begin // if count=0 then begin if (Self.IniFileName='') or not FileExists(Self.IniFileName) then begin Result:=cFileDoesNotExist; exit; end; {$IFNDEF VER90} Capacity:=500; {$ENDIF} Sorted:=False; with WebIni do begin IniFileName:=Self.IniFileName; Open; ReadSections(Handle,fBrowsers); //Close; end; //StoreHashValue:=True; //SortByObject:=True; Sorted:=True; end; // if (indexOf(fUserAgent)<>-1) then result:= fUserAgent else begin for i:= 0 to pred(count) do if MatchesWith(fUserAgent,strings[i]) then begin result:= strings[i]; exit; end; if (indexOf(cDefaultBrowserSection)<>-1) then result:= cDefaultBrowserSection else result:= ''; end; end; end; //------------------------------------------------------------------------------ const BoolStr: Array[false..true] of char = ('F','T'); procedure TwhBrowserInfo.SetSaveState(const State:String); var a1,a2:string; i:integer; begin if not DoSaveState then inherited SetSaveState(State) else begin SplitString(State,'|',a1,a2); //if length(a1)=4 then begin a1:=LongIntToBoolStr(HexToInt(a1),15); i:=1; fActiveXControls:= (a1[i]=BoolStr[True]); inc(i); fAK:= (a1[i]=BoolStr[True]); inc(i); fAOL:= (a1[i]=BoolStr[True]); inc(i); fBackgroundSounds:= (a1[i]=BoolStr[True]); inc(i); fBeta:= (a1[i]=BoolStr[True]); inc(i); fCDF:= (a1[i]=BoolStr[True]); inc(i); fCookies:= (a1[i]=BoolStr[True]); inc(i); fCrawler:= (a1[i]=BoolStr[True]); inc(i); fFrames:= (a1[i]=BoolStr[True]); inc(i); fJavaApplets:= (a1[i]=BoolStr[True]); inc(i); fJavaScript:= (a1[i]=BoolStr[True]); inc(i); fSK:= (a1[i]=BoolStr[True]); inc(i); fTables:= (a1[i]=BoolStr[True]); inc(i); fVBScript:= (a1[i]=BoolStr[True]); inc(i); fWin16:= (a1[i]=BoolStr[True]); //end; inherited SetSaveState(a2); end; end; function TwhBrowserInfo.GetSaveState:String; begin Result:=''; if DoSaveState and (fBrowsers.Count>0) then begin Result:= IntToHex(BoolStrToLongint( // BoolStr[fActiveXControls] +BoolStr[fAK] +BoolStr[fAOL] // +BoolStr[fBackgroundSounds] +BoolStr[fBeta] +BoolStr[fCDF] +BoolStr[fCookies] // +BoolStr[fCrawler] +BoolStr[fFrames] +BoolStr[fJavaApplets] +BoolStr[fJavaScript] // +BoolStr[fSK] +BoolStr[fTables] +BoolStr[fVBScript] +BoolStr[fWin16] ),4)+'|'; while (length(Result)>0) and (Result[1]='0') do delete(result,1,1); end; // Result:= Result+ inherited GetSaveState; fCapabilities.Clear; end; //------------------------------------------------------------------------------ function TwhBrowserInfo.Refresh: Boolean; var b: boolean; begin fBrowsers.Clear; if assigned(WebApp) then begin b:= WebApp.NewSession; WebApp.NewSession:= True; try try Result:=inherited refresh; finally WebApp.NewSession:= b; end except on e:EIniFileBusy do //ignore Result:=True; end; end else Result:=inherited refresh; end; function TwhBrowserInfo.DoUpdate: Boolean; procedure ReadCapabilities(const Value: string); var t: TStringList; i: integer; key,str: string; begin if (Value='') or not WebIni.IsOpen or (Value=cFileDoesNotExist) then exit; // with WebIni do begin Section:=Value; key:= StringEntry['Parent']; end; if ((key<>'') and (key<>Value)) then ReadCapabilities(key); // t:= TStringList.create; with t do try WebIni.Open; WebIni.Handle.ReadSectionValues(Value, t); for i:= 0 to pred(count) do begin splitstring(strings[i],cEq,key,str); fCapabilities.Values[key]:= str; end; finally free; end; end; begin Result:=inherited DoUpdate; if not Result then exit; // whsample_UserAgent.DecodeUserAgent(fUserAgent, fMake,fModel,fMajor,fMinor,fMozMajor,fMozMinor,fLanguage,fOS,fProxy); // if not assigned(WebApp) or WebApp.NewSession //or not fDoSaveState then begin // fCapabilities.Clear; if (fUserAgent<>'') and (IniFileName<>'') then if not fileexists(IniFileName) then //result is true even though the capabilities file does not exist. exit else begin {$IFNDEF VER90} fCapabilities.Capacity:=30; {$ENDIF} with WebIni do begin IniFileName:=Self.IniFileName; LeaveOpen:=True; Open; end; try ReadCapabilities(IniSection); finally WebIni.Close; end; end; // with fCapabilities do begin //enable fast retrieval Sorted:=True; //set properties for the current browser fActiveXControls:= StrToBool(Values['ActiveXControls']); fAK:= StrToBool(Values['AK']); fAOL:= StrToBool(Values['AOL']); fBackgroundSounds:= StrToBool(Values['BackgroundSounds']); fBeta:= StrToBool(Values['Beta']); fCDF:= StrToBool(Values['CDF']); fCookies:= StrToBool(Values['Cookies']); fCrawler:= StrToBool(Values['Crawler']); fFrames:= StrToBool(Values['Frames']); fJavaApplets:= StrToBool(Values['JavaApplets']); fJavaScript:= StrToBool(Values['JavaScript']); fSK:= StrToBool(Values['SK']); fTables:= StrToBool(Values['Tables']); fVBScript:= StrToBool(Values['VBScript']); fWin16:= StrToBool(Values['Win16']); end; end; end; // procedure TwhBrowserInfo.Execute; begin inherited Execute; if assigned(WebApp) and assigned(WebApp.WebServer) then begin UserAgent:=WebApp.WebServer.CgiUserAgent; //Update; end; end; // function TwhBrowserInfo.GetShortName: string; begin result:=fMake+fMajor; end; function TwhBrowserInfo.GetShortName2: string; begin result:=fMake+AddToString(fMajor,fMinor,'.'); end; function TwhBrowserInfo.GetMozLevel: string; begin result:=AddToString(fMozMajor,fMozMinor,'.'); end; // function TwhBrowserInfo.GetBrowser: string; begin result:= fCapabilities.Values['Browser']; end; function TwhBrowserInfo.GetVersionString: string; begin result:= fCapabilities.Values['Version']; end; function TwhBrowserInfo.GetPlatform: string; begin result:= fCapabilities.Values['Platform']; end; initialization {$IFDEF Log2File} tpLogMessage('whbroinf.pas initialization'); {$ENDIF} RegisterClass(TwhBrowserInfo); //d:\delphi\40\source\vcl\classes.pas {$IFDEF Log2File} tpLogMessage('whbroinf.pas initialization done.'); {$ENDIF} end.