Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/GikoSystem.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.185 by h677, Mon May 23 13:59:00 2005 UTC revision 1.186 by h677, Fri Jun 10 14:02:57 2005 UTC
# Line 18  uses Line 18  uses
18          Sort, GikoBayesian;          Sort, GikoBayesian;
19    
20  type  type
21            TVerResourceKey = (
22                      vrComments,         // コメント
23                      vrCompanyName,      // 会社名
24                      vrFileDescription,  // 説明
25                      vrFileVersion,      // ファイルバージョン
26                      vrInternalName,     // 内部名
27                      vrLegalCopyright,   // 著作権
28                      vrLegalTrademarks,  // 商標
29                      vrOriginalFilename, // 正式ファイル名
30                      vrPrivateBuild,     // プライベートビルド情報
31                      vrProductName,      // 製品名
32                      vrProductVersion,   // 製品バージョン
33                      vrSpecialBuild);     // スペシャルビルド情報
34    
35          //BBSタイプ          //BBSタイプ
36          TGikoBBSType = (gbt2ch);          TGikoBBSType = (gbt2ch);
37          //ログタイプ          //ログタイプ
# Line 85  type Line 99  type
99                  FNoParam: Boolean;              //レス番パラメータなし                  FNoParam: Boolean;              //レス番パラメータなし
100          end;          end;
101    
102      //MessageList          //MessageList
103      TGikoMessageListType = (gmLogout, gmLogin, gmForceLogin, gmSureItiran,          TGikoMessageListType = (gmLogout, gmLogin, gmForceLogin, gmSureItiran,
104              gmUnKnown, gmSureSyutoku, gmSureDiff, gmNotMod, gmAbort, gmError,                          gmUnKnown, gmSureSyutoku, gmSureDiff, gmNotMod, gmAbort, gmError,
105              gmNewRes, gmNewSure, gmResError, gmSureError);                          gmNewRes, gmNewSure, gmResError, gmSureError);
106    
107          TGikoSys = class(TObject)          TGikoSys = class(TObject)
108          private          private
# Line 98  type Line 112  type
112                  FAWKStr: TAWKStr;                  FAWKStr: TAWKStr;
113                  FResRange : Longint;                  FResRange : Longint;
114                  FBayesian       : TGikoBayesian;        //!< ベイジアンフィルタ                  FBayesian       : TGikoBayesian;        //!< ベイジアンフィルタ
115                    FVersion : String;              //ファイルバージョン
116  //              FExitWrite: TStringList;  //              FExitWrite: TStringList;
117  //              function StrToFloatDef(s: string; Default: Double): Double;  //              function StrToFloatDef(s: string; Default: Double): Double;
118                  function SetUserOptionalStyle(): string;                  function SetUserOptionalStyle(): string;
# Line 111  type Line 125  type
125    
126                  destructor Destroy; override;                  destructor Destroy; override;
127                  property ResRange : Longint read FResRange write FResRange;                  property ResRange : Longint read FResRange write FResRange;
128                    //バージョン情報
129                    property Version : String read FVersion;
130  //              function MsgBox(Msg: string; Title: string; Flags: Longint): integer; overload;  //              function MsgBox(Msg: string; Title: string; Flags: Longint): integer; overload;
131  //              function MsgBox(Handle: THandle; Msg: string; Title: string; Flags: Longint): integer; overload;  //              function MsgBox(Handle: THandle; Msg: string; Title: string; Flags: Longint): integer; overload;
132                  function IsNumeric(s: string): boolean;                  function IsNumeric(s: string): boolean;
# Line 234  type Line 250  type
250                  procedure SpamLearn( wordCount : TWordCount; isSpam : Boolean );                  procedure SpamLearn( wordCount : TWordCount; isSpam : Boolean );
251                  //! スパム度数                  //! スパム度数
252                  function SpamParse( const text : string; wordCount : TWordCount ) : Extended;                  function SpamParse( const text : string; wordCount : TWordCount ) : Extended;
253          //引数が、日付でも時刻でもないことを調べる                  //引数が、日付でも時刻でもないことを調べる
254                  function NotDateorTimeString(const AStr : string): boolean;                  function NotDateorTimeString(const AStr : string): boolean;
255          //引数に送られてきた日付/ID部にBEの文字列があったら、プロファイルへのリンクを追加                  //引数に送られてきた日付/ID部にBEの文字列があったら、プロファイルへのリンクを追加
256          function AddBeProfileLink(AID : string; ANum: Integer): string;                  function AddBeProfileLink(AID : string; ANum: Integer): string;
257                    //バージョン情報の取得
258                    function GetVersionInfo(KeyWord: TVerResourceKey): string;
259    
260          end;          end;
261    
262  var  var
# Line 250  const Line 269  const
269          BETA_VERSION                            = 50;          BETA_VERSION                            = 50;
270          BETA_VERSION_BUILD      = '';                           //debug版など          BETA_VERSION_BUILD      = '';                           //debug版など
271          APP_NAME                                                = 'gikoNavi';          APP_NAME                                                = 'gikoNavi';
272      BE_PHP_URL = 'http://be.2ch.net/test/p.php?i=';          BE_PHP_URL = 'http://be.2ch.net/test/p.php?i=';
273    
274            KeyWordStr: array [TVerResourceKey] of String = (
275                      'Comments',
276                      'CompanyName',
277                      'FileDescription',
278                      'FileVersion',
279                      'InternalName',
280                      'LegalCopyright',
281                      'LegalTrademarks',
282                      'OriginalFilename',
283                      'PrivateBuild',
284                      'ProductName',
285                      'ProductVersion',
286                      'SpecialBuild');
287    
288  implementation  implementation
289    
# Line 294  begin Line 327  begin
327          FSelectResFilter.AbonString := '';          FSelectResFilter.AbonString := '';
328          //          //
329          ResRange := FSetting.ResRange;          ResRange := FSetting.ResRange;
330            FVersion := Trim(GetVersionInfo(vrFileVersion));
331          FBayesian := TGikoBayesian.Create;          FBayesian := TGikoBayesian.Create;
332          FBoardURLList := TStringList.Create;          FBoardURLList := TStringList.Create;
333  end;  end;
# Line 465  end; Line 499  end;
499  function TGikoSys.GetUserAgent: string;  function TGikoSys.GetUserAgent: string;
500  begin  begin
501          if Dolib.Connected then begin          if Dolib.Connected then begin
502                  Result := Format('%s %s/%s%d%s', [                  Result := Format('%s %s/%s%d/%s', [
503                                                                  Dolib.UserAgent,                                                                  Dolib.UserAgent,
504                                                                  APP_NAME,                                                                  APP_NAME,
                                                                 //MAJOR_VERSION,  
                                                                 //MINOR_VERSION,  
505                                                                  BETA_VERSION_NAME_E,                                                                  BETA_VERSION_NAME_E,
506                                                                  BETA_VERSION,                                                                  BETA_VERSION,
507                                                                  BETA_VERSION_BUILD]);                                                                  Version]);
508          end else begin          end else begin
509                  Result := Format('%s/%s %s/%s%d%s', [                  Result := Format('%s/%s %s/%s%d/%s', [
510                                                                  USER_AGENT,                                                                  USER_AGENT,
511                                                                  Dolib.Version,                                                                  Dolib.Version,
512                                                                  APP_NAME,                                                                  APP_NAME,
                                                                 //MAJOR_VERSION,  
                                                                 //MINOR_VERSION,  
513                                                                  BETA_VERSION_NAME_E,                                                                  BETA_VERSION_NAME_E,
514                                                                  BETA_VERSION,                                                                  BETA_VERSION,
515                                                                  BETA_VERSION_BUILD]);                                                                  Version]);
516          end;          end;
517  end;  end;
518    
# Line 4035  end; Line 4065  end;
4065  function TGikoSys.AddBeProfileLink(AID : string; ANum: Integer):string ;  function TGikoSys.AddBeProfileLink(AID : string; ANum: Integer):string ;
4066  var  var
4067          p : integer;          p : integer;
4068      BNum, BMark : string;          BNum, BMark : string;
4069  begin  begin
4070      p := AnsiPos('BE:', AnsiUpperCase(AID));          p := AnsiPos('BE:', AnsiUpperCase(AID));
4071      if p > 0 then begin          if p > 0 then begin
4072          BNum := Copy(AID, p, Length(AID));                  BNum := Copy(AID, p, Length(AID));
4073          AID := Copy(AID, 1, p - 1);                  AID := Copy(AID, 1, p - 1);
4074          p := AnsiPos('-', BNum);                  p := AnsiPos('-', BNum);
4075          if p > 0 then begin                  if p > 0 then begin
4076              BMark := '?' + Trim(Copy(BNum, p + 1, Length(BNum)));                          BMark := '?' + Trim(Copy(BNum, p + 1, Length(BNum)));
4077                  BNum := Copy(BNum, 1, p - 1);                          BNum := Copy(BNum, 1, p - 1);
4078          end;                  end;
4079          BNum := Trim(BNum);                  BNum := Trim(BNum);
4080          Result := AID + ' <a href="'  + BNum + '/' + IntToStr(ANum)                  Result := AID + ' <a href="'  + BNum + '/' + IntToStr(ANum)
4081              + '" target=_blank>' + BMark + '</a>';                          + '" target=_blank>' + BMark + '</a>';
4082      end else          end else
4083          Result := AID;                  Result := AID;
4084  end;  end;
4085    // バージョン情報を取得
4086    function TGikoSys.GetVersionInfo(KeyWord: TVerResourceKey): string;
4087    const
4088            Translation = '\VarFileInfo\Translation';
4089            FileInfo = '\StringFileInfo\%0.4s%0.4s\';
4090    var
4091            BufSize, HWnd: DWORD;
4092            VerInfoBuf: Pointer;
4093            VerData: Pointer;
4094            VerDataLen: Longword;
4095            PathLocale: String;
4096    begin
4097            // 必要なバッファのサイズを取得
4098            BufSize := GetFileVersionInfoSize(PChar(Application.ExeName), HWnd);
4099            if BufSize <> 0 then begin
4100                    // メモリを確保
4101                    GetMem(VerInfoBuf, BufSize);
4102                    try
4103                            GetFileVersionInfo(PChar(Application.ExeName), 0, BufSize, VerInfoBuf);
4104                            // 変数情報ブロック内の変換テーブルを指定
4105                            VerQueryValue(VerInfoBuf, PChar(Translation), VerData, VerDataLen);
4106    
4107                            if not (VerDataLen > 0) then
4108                                    raise Exception.Create('情報の取得に失敗しました');
4109    
4110                            // 8桁の16進数に変換
4111                            // →'\StringFileInfo\027382\FileDescription'
4112                            PathLocale := Format(FileInfo + KeyWordStr[KeyWord],
4113                            [IntToHex(Integer(VerData^) and $FFFF, 4),
4114                            IntToHex((Integer(VerData^) shr 16) and $FFFF, 4)]);
4115                            VerQueryValue(VerInfoBuf, PChar(PathLocale), VerData, VerDataLen);
4116    
4117                            if VerDataLen > 0 then begin
4118                                    // VerDataはゼロで終わる文字列ではないことに注意
4119                                    result := '';
4120                                    SetLength(result, VerDataLen);
4121                                    StrLCopy(PChar(result), VerData, VerDataLen);
4122                            end;
4123                    finally
4124                            // 解放
4125                            FreeMem(VerInfoBuf);
4126                    end;
4127            end;
4128    end;
4129    
4130    
4131    
4132  initialization  initialization
4133          GikoSys := TGikoSys.Create;          GikoSys := TGikoSys.Create;

Legend:
Removed from v.1.185  
changed lines
  Added in v.1.186

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26