ondemandu.~pas

Ondemand是IBM公司开发的报表管理系统,广泛使用于金融、保险、电信等大型企业. 但是由于某些原因,其报表下载和检索功能作的并不尽如人意,本程序是对Ondemand报表系统的下载和检索

unit OndemandU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActnList, ExtCtrls, Mask, OleCtrls, ARSOLELib_TLB,
  Grids, DBGrids, ComCtrls, Menus, FileCtrl, OleCtnrs, XPMan,
  ValEdit,DirDlgU;

type
  TOndemandFormX = class(TForm)
    Panel1: TPanel;
    Panel3: TPanel;
    Ser1: TEdit;
    Usr1: TEdit;
    Pas1: TMaskEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Panel4: TPanel;
    ActionList1: TActionList;
    LoginAction: TAction;
    Button1: TButton;
    V1: TTreeView;
    OpenDir: TAction;
    PopupMenu1: TPopupMenu;
    OpenDir1: TMenuItem;
    DownLoadAll: TAction;
    Label5: TStatusBar;
    RemoteSearch: TAction;
    DownAndSearch: TAction;
    As1: TArsOle;
    PopupMenu2: TPopupMenu;
    Action1: TAction;
    N1: TMenuItem;
    Action2: TAction;
    N2: TMenuItem;
    N3: TMenuItem;
    PopupMenu3: TPopupMenu;
    OpenDocAction: TAction;
    N4: TMenuItem;
    N5: TMenuItem;
    DownLoadTheRep: TAction;
    N6: TMenuItem;
    N7: TMenuItem;
    Savex: TSaveDialog;
    N8: TMenuItem;
    Splitter3: TSplitter;
    Panel6: TPanel;
    Ole1: TOleContainer;
    G2: TStringGrid;
    Label4: TLabel;
    T1: TEdit;
    Button3: TButton;
    G1: TStringGrid;
    Splitter1: TSplitter;
    SelectAll: TAction;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    UnselAll: TAction;
    RadioGroup1: TRadioGroup;
    Open1: TOpenDialog;
    procedure LoginActionExecute(Sender: TObject);
    procedure V1Change(Sender: TObject; Node: TTreeNode);
    procedure Button2Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure OpenDirExecute(Sender: TObject);
    procedure DownLoadAllExecute(Sender: TObject);
    procedure As1FolderSearchCompleted(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure As1FolderClosed(Sender: TObject);
    procedure RemoteSearchExecute(Sender: TObject);
    procedure DownAndSearchExecute(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure V1Click(Sender: TObject);
    procedure G1DblClick(Sender: TObject);
    procedure OpenDocActionExecute(Sender: TObject);
    procedure DownLoadTheRepExecute(Sender: TObject);
    procedure PopupMenu3Popup(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure PopupMenu2Popup(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SelectAllExecute(Sender: TObject);
    procedure UnselAllExecute(Sender: TObject);
    procedure G1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

  private
    S1,KK1:TStringList;
    Fp,Fp2:Text;
    { Private declarations }
  public
    procedure GetFolders;
    function GetFileName(i:integer):string;
    procedure GetDocNames(FD:TTreeNode);
    procedure ClearG1;
    function GetDirx:string;
    function DirFile(Dir:string):Boolean;
    function FindStrInResult(substr:string):Boolean;

    { Public declarations }
  end;

var
  OndemandFormX: TOndemandFormX;

implementation

uses CommXU;

{$R *.dfm}

procedure TOndemandFormX.LoginActionExecute(Sender: TObject);
var tmp:OleVariant;
    ret,count,i:integer;
    wstr:widestring;
    str:String;
begin
  As1.Logoff;
  if As1.Logon(Ser1.Text,Usr1.Text,Pas1.Text)<>0 then
  begin
    ShowMessage('登录失败');
    exit;
  end ;
  Label5.SimpleText:='状态:登录成功';
  V1.Items.BeginUpdate;
  GetFolders();
  V1.Items.EndUpdate;
end;



procedure TOndemandFormX.GetDocNames(FD: TTreeNode);
begin

end;

procedure TOndemandFormX.GetFolders;
var tmp:OleVariant;
    ret,count,i:integer;
    wstr:widestring;
    str:wideString;
    node:TTreeNode;
begin
  V1.Items.Clear;
  try
    ret:=As1.GetNumFolders(tmp);
    count:=tmp;
    if ret<>0 then
    begin
      ShowMessage('不能获取目录数:'+IntToStr(count));
      exit;
    end;
    for i:=0 to count-1 do
    begin
      As1.GetFolderName(i,wstr);
      str:=wstr;
      node:=V1.Items.AddFirst(nil,str);
    end;
  except
    exit;
  end;
end;

procedure TOndemandFormX.V1Change(Sender: TObject; Node: TTreeNode);
var tmp:Olevariant;
    i,count:integer;
    wstr:widestring;
    str:string;
begin
  if Node=nil then exit;
  As1.CloseAllFolders;
  As1.OpenFolder(V1.Selected.Text);
  As1.GetNumFolderFields(tmp);
  count:=tmp;
  ClearG1;
  G1.RowCount:=2;
  G1.ColCount:=count+1;
  G1.FixedRows:=1;
  G1.FixedCols:=0;
  G1.Row:=1;
  KK1.Clear;
  G1.Cells[0,0]:='选择';
  G1.ColWidths[0]:=30;
  for i:=0 to count-1 do
  begin
    As1.GetFolderFieldName(i,wstr);
    KK1.Add(wstr);
    G1.Cells[i+1,0]:=wstr;
    str:=wstr;
    G1.ColWidths[i+1]:=length(str)*20;
  end;
  V1.SetFocus;
end;

procedure TOndemandFormX.Button2Click(Sender: TObject);
var tmp:OleVariant;
    count,ret,docindex,valueindex,i,j:integer;
    wstr,ddc,line:widestring;
begin
  As1.GetNumFolderDisplayFields(tmp);
  valueindex:=tmp;
  docindex:=tmp;
  docindex:=1;
  for i:=0 to docindex-1 do
  begin
    line:='';
    for j:=0 to valueindex-1 do
    begin
      wstr:='';
      As1.GetDocDisplayValue(i,j,wstr);
      As1.GetFolderDisplayFieldName(j,ddc);
      wstr:=ddc+':'+wstr;
      line:=line+','+wstr;
    end;
  end;
end;

procedure TOndemandFormX.PopupMenu1Popup(Sender: TObject);
begin
  OpenDir.Enabled:=not( V1.Selected=nil  );
end;

procedure TOndemandFormX.OpenDirExecute(Sender: TObject);
var tmp:Olevariant;
    i,count:integer;
    wstr:widestring;
    str:string;
begin
  V1Change(V1,V1.Selected);
  As1.ShowFolder(1,(Screen.Width div 2)-400,(Screen.Height div 2)-300,(Screen.Width div 2)+400,(Screen.Height div 2)+300);
end;

procedure TOndemandFormX.DownLoadAllExecute(Sender: TObject);
var tmp:OleVariant;
    i,count:integer;
    fn,dirs:string;
begin
  dirs:=GetDirx;
  if dirs='' then
  begin
    ShowMessage('没有选择报表保存目录,下载取消');
    exit;
  end;
  As1.GetNumDocsInList(tmp);
  count:=tmp;
  if count=0 then
  begin
    ShowMessage('状态:没有选择的文件或者文件查询画面已经关闭!');
    exit;
  end;

  for i:=0 to count-1 do
  begin
    if G1.Cells[0,i+1]='' then continue;
    fn:=dirs+'\'+GetFileName(i);
    try
      if FileExists(fn) then DeleteFile(fn);
    except
    end;
    Label5.SimpleText:=format('状态:正在下载文件 %d/%d %s',[i,count,fn]);
    As1.RetrieveDoc(i,fn,'','');
  end;
  Label5.SimpleText:='状态:下载完毕';
end;

procedure TOndemandFormX.As1FolderSearchCompleted(Sender: TObject);
var tmp:OleVariant ;
    i,count,j:integer;
    wstr:widestring;
begin
  As1.GetNumDocsInList(tmp);
  i:=tmp;
  count:=tmp;
  G1.RowCount:=1;
  Label5.SimpleText:=format('状态:共搜索到%d份文件',[i]);
  DownLoadAll.Enabled:=True;
  RemoteSearch.Enabled:=True;
  DownAndSearch.Enabled:=True;
  for i:=0 to count-1 do
  begin
    G1.RowCount:=G1.RowCount+1;
    G1.FixedRows:=1;
    G1.Cells[0,i+1]:='√';
    for j:=1 to G1.ColCount-1 do
    begin
      As1.GetDocDisplayValue(i,j-1,wstr);
      G1.Cells[j,i+1]:=wstr;
    end;
  end;

end;

function TOndemandFormX.GetFileName(i: integer): string;
var fn,str:widestring;
    j:integer;
begin
  fn:='';
  for j:=0 to KK1.Count-1 do
  begin
    As1.GetDocDisplayValue(i,j,str);
    fn:=fn+'.'+trim(str);
  end;
  fn:=fn+'_'+IntToStr(i)+'.txt';
  delete(fn,1,1);
  Result:=fn;
end;

procedure TOndemandFormX.FormCreate(Sender: TObject);
begin
  S1:=TStringList.Create;
  KK1:=TStringList.Create;
  //Lb2.ColWidths[1]:=1024;
  G2.RowCount:=2;
  G2.ColCount:=2;
  G2.FixedCols:=0;
  G2.FixedRows:=1;
  G2.Cells[0,0]:='文件名';
  G2.Cells[1,0]:='搜索结果';
  G2.ColWidths[1]:=G2.Width-G2.ColWidths[0];
end;

procedure TOndemandFormX.As1FolderClosed(Sender: TObject);
var i:integer;
begin
  Label5.SimpleText:='状态:文件夹被关闭';
  DownLoadAll.Enabled:=False;
  RemoteSearch.Enabled:=False;
  DownAndSearch.Enabled:=True;
  ClearG1;
  V1Change(V1,V1.Selected);
end;

procedure TOndemandFormX.RemoteSearchExecute(Sender: TObject);
var tmp:OleVariant;
    count,i:integer;
begin
  As1.GetNumDocsInList(tmp);
  count:=0;
  for i:=0 to count-1 do
  begin

  end;
end;

procedure TOndemandFormX.DownAndSearchExecute(Sender: TObject);
var tmp:OleVariant;
    i,count:integer;
    fn,line,dir1:string;
    S33:TStringList;