ExtPreviewDatamodule.pas

   1 unit ExtPreviewDatamodule;
   2
   3 interface
   4
   5 uses
   6   SysUtils, Classes, bmRegExp, ExtCtrls, GikoSystem;
   7
   8 type
   9   TCommand = class(TObject)
  10   private
  11     FCommand: String;
  12     FConfirm: Boolean;
  13     FContinue: Boolean;
  14     FToURL: String;
  15   public
  16     constructor Create(const comm: String);
  17     property Command: String read FCommand;
  18     property Confirm: Boolean read FConfirm write FConfirm;
  19     property Continue: Boolean read FContinue write FContinue;
  20     property ToURL: String read FToURL write FToURL;
  21   end;
  22
  23   TExtPreviewDM = class(TDataModule)
  24     ExecuteTimer: TTimer;
  25     procedure DataModuleCreate(Sender: TObject);
  26     procedure DataModuleDestroy(Sender: TObject);
  27     procedure ExecuteTimerTimer(Sender: TObject);
  28   private
  29     { Private \90é\8c¾ }
  30         FAWKStr: TAWKStr;
  31     FRegs: TStringList;
  32     FExecCommand: TCommand;
  33     function ReadCommand(const Line: String): TCommand;
  34   public
  35     { Public \90é\8c¾ }
  36     function PreviewURL(const URL: String): Boolean;
  37   end;
  38
  39 var
  40   ExtPreviewDM: TExtPreviewDM;
  41
  42 implementation
  43
  44 uses
  45   IniFiles, GikoUtil, Windows;
  46
  47 constructor TCommand.Create(const comm: String);
  48 begin
  49     FCommand := comm;
  50     FConfirm := False;
  51     FContinue := False;
  52     FToURL := '';
  53 end;
  54 {$R *.dfm}
  55 {
  56 \brief \83R\83\93\83X\83g\83\89\83N\83^
  57 }
  58 procedure TExtPreviewDM.DataModuleCreate(Sender: TObject);
  59 var
  60     values: TStringList;
  61     i, pos: Integer;
  62 begin
  63     FAWKStr := TAWKStr.Create(Self);
  64     FRegs := TStringList.Create;
  65     if (FileExists(GikoSys.GetExtpreviewFileName)) then begin
  66         values := TStringList.Create;
  67         try
  68             values.LoadFromFile(GikoSys.GetExtpreviewFileName);
  69             for i := 0 to values.Count - 1 do begin
  70                 if ( AnsiPos('#',values[i]) = 1 ) then begin
  71                     // \90æ\93ª#\82Å\8en\82Ü\82é\82Í\83R\83\81\83\93\83g\8ds
  72                 end else begin
  73                     pos := AnsiPos(#9,values[i]);
  74                     if (pos > 0) then begin
  75                         FRegs.AddObject(
  76                             Copy(values[i], 1, pos - 1),
  77                             ReadCommand(
  78                                 Copy(values[i], pos + 1, Length(values[i])))
  79                                 );
  80                     end;
  81                 end;
  82             end;
  83         finally
  84             values.Free;
  85         end;
  86     end;
  87 end;
  88 {
  89 \brief \83f\83X\83g\83\89\83N\83^
  90 }
  91 procedure TExtPreviewDM.DataModuleDestroy(Sender: TObject);
  92 begin
  93     FRegs.Clear;
  94     FRegs.Free;
  95     FAWKStr.Free;
  96 end;
  97 {
  98 \brief \83R\83}\83\93\83h\8ds\89ð\8eß
  99 }
 100 function TExtPreviewDM.ReadCommand(const Line: String): TCommand;
 101 var
 102     pos: Integer;
 103     sub: String;
 104 begin
 105
 106     // FCommand , FConfirm , FContinue \82Ì\8f\87
 107     pos := AnsiPos(#9, Line);
 108     if (pos > 0) then begin
 109         Result := TCommand.Create( Copy(Line, 1, pos - 1) );
 110         sub := Copy(Line, pos + 1, Length(Line));
 111     end else begin
 112         Result := TCommand.Create( '' );
 113         sub := '';
 114     end;
 115     pos := AnsiPos(#9, sub);
 116     if (pos > 0) then begin
 117         if (AnsiLowerCase(Copy(sub, 1, pos - 1)) = 'true' ) then begin
 118             Result.Confirm := True;
 119         end;
 120         sub := Copy(Line, pos + 1, Length(Line));
 121     end;
 122     sub := Trim(sub);
 123     if (AnsiLowerCase(sub) = 'true' ) then begin
 124         Result.Continue := True;
 125     end;
 126 end;
 127 {
 128 \brief \93o\98^\82³\82ê\82½URL\82ð\8f\88\97\9d\82·\82é\83R\83}\83\93\83h\82ð\95Ô\82·
 129 }
 130 function TExtPreviewDM.PreviewURL(const URL: String): Boolean;
 131 var
 132     i: Integer;
 133     RStart: Integer;
 134     RLength: Integer;
 135     EsqURL: String;
 136 begin
 137     Result := False;
 138     ExecuteTimer.Interval := 0;
 139     ExecuteTimer.Enabled := False;
 140     FExecCommand := nil;
 141     if (Length(URL) > 0) and (FRegs.Count > 0) then begin
 142         EsqURL := FAWKStr.ProcessEscSeq(URL);
 143         for i := 0 to FRegs.Count - 1 do begin
 144             FAWKStr.RegExp := FRegs[i];
 145             if ( FAWKStr.Match(EsqURL, RStart, RLength ) <> 0 ) then begin
 146                 FExecCommand := TCommand(FRegs.Objects[i]);
 147                 FExecCommand.ToURL := Copy(EsqURL, RStart, RLength);
 148                 ExecuteTimer.Interval := GikoSys.Setting.PreviewWait;
 149                 ExecuteTimer.Enabled := True;
 150                 Result := not FExecCommand.FContinue;
 151                 break;
 152             end;
 153         end;
 154     end;
 155 end;
 156
 157 procedure TExtPreviewDM.ExecuteTimerTimer(Sender: TObject);
 158 var
 159     rc: Integer;
 160 begin
 161     // \83^\83C\83}\81[\92â\8e~
 162     ExecuteTimer.Interval := 0;
 163     ExecuteTimer.Enabled := False;
 164
 165     if (FExecCommand <> nil) then begin
 166         rc := ID_YES;
 167         if (FExecCommand.Confirm) then begin
 168             // Msg
 169             rc := GikoUtil.MsgBox(0, FExecCommand.Command + '\82É'#13#10 +
 170                 FExecCommand.ToURL + ' \82ð\93n\82µ\82Ü\82·\82©\81H',
 171                 '\8am\94F', MB_ICONQUESTION or MB_YESNO);
 172         end;
 173
 174         if (rc = ID_YES) then begin
 175             // \93Á\8eê\83R\83}\83\93\83h
 176             // nop \89½\82à\82µ\82È\82¢
 177             if (AnsiLowerCase(FExecCommand.Command) <> 'nop') then begin
 178                 GikoSys.CreateProcess(
 179                     FExecCommand.Command, '"' + FExecCommand.ToURL + '"');
 180             end;
 181         end;
 182     end;
 183 end;
 184
 185 end.