ondemandu.~pas

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

    row,col:integer;
begin
  S1.Clear;
  case RadioGroup1.ItemIndex of
    0:begin
        dir1:=GetDirx;
        if dir1='' then exit;
        As1.GetNumDocsInList(tmp);
        count:=tmp;
        if count=0 then
        begin
          ShowMessage('状态:没有选择的文件或者文件查询画面已经关闭!');
          exit;
        end;
        S1.Clear;
        for i:=0 to count-1 do
        begin
          if G1.Cells[0,i+1]='' then continue;
          fn:=Dir1+'\'+GetFileName(i);
          try
            if FileExists(fn) then DeleteFile(fn);
          except
          end;
          Label5.SimpleText:=format('状态:正在下载文件 %d/%d %s',[i,count,fn]);
          if (As1.RetrieveDoc(i,fn,'','')=0) then S1.Add(fn);
        end;
        Label5.SimpleText:='状态:下载完毕';
      end;
    1:begin
        Comm1.DirLabel:='';
        Comm1.DirLabel:=GetDirx;
        //if Comm1.DirLabel[length(Comm1.DirLabel)]='\' then delete(Comm1.DirLabel,length(Comm1.DirLabel),1);
        if Comm1.DirLabel='' then
        begin
          ShowMessage('检索被取消');
          exit;
        end;
        DirFile(Comm1.DirLabel);
      end;
    2:begin
        if not Open1.Execute then  exit;
        if Open1.FileName='' then exit;
        if not FileExists(Open1.FileName) then exit;
        S1.Add(Open1.FileName);
      end;
    3:begin
        FindStrInResult(T1.Text);
        exit;
      end;
  else begin
         ShowMessage('选择处理方式');
         exit;
       end;
  end;
  for i:=1 to G2.RowCount-1 do G2.Rows[i].Clear;
  G2.RowCount:=2;
  G2.FixedRows:=1;
  S33:=TStringList.Create;
  try
    for i:=0 to S1.Count-1 do
    begin
      AssignFile(Fp,s1.Strings[i]);
      Label5.SimpleText:=format('状态:正在搜索 %d/%d %s',[i,S1.Count-1,s1.Strings[i]]);
      try
        Reset(Fp);
        Readln(Fp,line);
        while not Eof(Fp) do
        begin
          if pos(T1.Text,line)>0 then
          begin
            G2.Cells[0,G2.RowCount-1]:=S1.Strings[i];
            G2.Cells[1,G2.RowCount-1]:=line;
            G2.RowCount:=G2.RowCount+1;
          end;
          Readln(Fp,line);
        end;
      finally
        CloseFile(Fp);
      end;
    end;
  finally
    Label5.SimpleText:='状态:搜索完毕';
    S33.Free;
  end;
end;

procedure TOndemandFormX.Action1Execute(Sender: TObject);
var i,j:integer;
    line:string;
begin
  if Savex.Execute then
    if Savex.FileName<>'' then
    begin
      AssignFile(Fp,SaveX.FileName);
      try
        ReWrite(Fp);
        for i:=1 to G2.RowCount-1 do
        begin
          line:=G2.Cells[0,i]+':'+G2.Cells[1,i];
          Writeln(Fp,line);
        end;
      finally
        CloseFile(Fp);
      end;
    end;
end;



procedure TOndemandFormX.V1Click(Sender: TObject);
var tmp:Olevariant;
    i,count:integer;
    wstr:widestring;
    str:string;
begin
  As1.CloseAllFolders;
  As1.OpenFolder(V1.Selected.Text);
  As1.GetNumFolderFields(tmp);
  count:=tmp;
  G1.RowCount:=2;
  G1.ColCount:=count;
  G1.FixedRows:=1;
  KK1.Clear;
  for i:=0 to count-1 do
  begin
    As1.GetFolderFieldName(i,wstr);
    KK1.Add(wstr);
    G1.Cells[i,0]:=wstr;
    str:=wstr;
    G1.ColWidths[i]:=length(str)*20;
  end;
  V1.SetFocus;
 // As1.ShowFolder(1,10,10,Screen.Height,Screen.Width);
end;

procedure TOndemandFormX.ClearG1;
var i:integer;
begin
  for i:=0 to G1.ColCount-1 do G1.Cols[i].Clear;
  G1.ColCount:=2;
  G1.RowCount:=2;
  G1.FixedCols:=0;
  G1.FixedRows:=1;
end;

procedure TOndemandFormX.G1DblClick(Sender: TObject);
var str,fn:string;
    i:integer;
begin
  if G1.Cells[0,G1.Row]='' then exit;
  fn:='c:\'+GetFileName(G1.Row-1);
  try
    if  FileExists(fn) then DeleteFile(fn);
  except
    ShowMessage('原文件删除失败');
  end;
  As1.RetrieveDoc(G1.Row-1,fn,'','');
  if not FileExists(fn) then
  begin
    ShowMessage('无法加载文件'+fn+',文件不存在');
    exit;
  end;
  try
    Ole1.CreateLinkToFile(fn,False);
    Ole1.DoVerb(0);
  except
    Ole1.Close;
    ShowMessage('无法打开文件'+fn);
  end;
end;

procedure TOndemandFormX.OpenDocActionExecute(Sender: TObject);
var str,fn:string;
    i:integer;
begin
  if G1.Cells[1,G1.Row]='' then exit;
  fn:='c:\'+GetFileName(G1.Row-1);
  try
    if  FileExists(fn) then DeleteFile(fn);
  except
    ShowMessage('原文件删除失败');
  end;
  Label5.SimpleText:='状态:正在下载报表';
  As1.RetrieveDoc(G1.Row-1,fn,'','');
  if not FileExists(fn) then
  begin
    ShowMessage('无法加载文件'+fn+',文件不存在');
    exit;
  end;
  Label5.SimpleText:='状态:下载完毕';
  Label5.SimpleText:='状态:正在准备打开报表';
  try
    Ole1.DestroyObject;
    Ole1.CreateLinkToFile(fn,False);
    Ole1.DoVerb(0);
  except
    Ole1.Close;
    ShowMessage('无法打开文件'+fn);
  end;
  Label5.SimpleText:='打开文件';
end;

function TOndemandFormX.GetDirx: string;
var dir4:TDir4;
begin
  Result:='';
  Comm1.DirLabel:='';
  dir4:=TDir4.Create(self);
  try
    dir4.ShowModal;
  except
    ShowMessage('目录画面打开失败');
    exit;
  end;
  if Comm1.DirLabel='' then exit;
  if Comm1.DirLabel[length(Comm1.DirLabel)]='\' then delete(Comm1.DirLabel,length(Comm1.DirLabel),1);
  Result:=Comm1.DirLabel;
end;

procedure TOndemandFormX.DownLoadTheRepExecute(Sender: TObject);
var fn:string;
begin
  if not SaveX.Execute then exit;
  if SaveX.FileName='' then exit;
  fn:=SaveX.FileName+'.txt';
  Label5.SimpleText:='状态:开始下载文件:'+fn;
  try
    if  FileExists(fn) then DeleteFile(fn);
  except
    ShowMessage('原文件删除失败');
  end;
  As1.RetrieveDoc(G1.Row-1,fn,'','');
  Label5.SimpleText:='状态:下载文件完毕:'+fn;
end;

procedure TOndemandFormX.PopupMenu3Popup(Sender: TObject);
var ret:Boolean;
begin
  ret:=(G1.Cells[1,G1.Row]<>'');
  DownLoadAll.Enabled:=ret;
  DownLoadTheRep.Enabled:=ret;
  OpenDocAction.Enabled:=ret;
end;

procedure TOndemandFormX.Action2Execute(Sender: TObject);
var fn:string;
begin
  fn:=G2.Cells[0,G2.Row];
  if not FileExists(fn) then
  begin
    ShowMessage('不存在文件'+fn);
    exit;
  end;
  try
    Ole1.DestroyObject;
    Ole1.CreateLinkToFile(fn,True);
    Ole1.DoVerb(0);
  except
    Ole1.Close;
    ShowMessage('不能打开文件');
  end;
end;

procedure TOndemandFormX.PopupMenu2Popup(Sender: TObject);
begin
  Action1.Enabled:=not  (G2.Cells[0,G2.Row]='' );
  Action2.Enabled:=not  (G2.Cells[0,G2.Row]='' );
end;

procedure TOndemandFormX.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action:=cafree;
end;

procedure TOndemandFormX.SelectAllExecute(Sender: TObject);
var i:integer;
begin
  for i:=1 to G1.RowCount-1 do
  begin
    if G1.Cells[1,i]='' then continue;
    G1.Cells[0,i]:='√';
  end;
end;

procedure TOndemandFormX.UnselAllExecute(Sender: TObject);
var i:integer;
begin
  for i:=1 to G1.RowCount-1 do
  begin
    if G1.Cells[1,i]='' then continue;
    G1.Cells[0,i]:='';
  end;
end;

procedure TOndemandFormX.G1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var rect:TRect;
begin
  if G1.Cells[1,G1.Row]='' then exit;
  rect:=G1.CellRect(0,G1.Row);
  if (x>=rect.Left)and(x<=rect.Right)and(y>=rect.Top)and(y<=rect.Bottom) then
  if G1.Cells[0,G1.Row]='' then G1.Cells[0,G1.Row]:='√'
  else G1.Cells[0,G1.Row]:='';
end;

function TOndemandFormX.DirFile(Dir: string): Boolean;
var sr: TSearchRec;
    ret:integer;
begin
  S1.Clear;      // Found := FindFirst("c:\dir\*2003年12月*.abc", Attr, SearchRec);
  ret:=FindFirst(Dir+'\*.txt',faAnyFile,sr);
  while ret=0 do
  begin
    S1.Add(Dir+'\'+sr.Name);
    ret:=FindNext(sr);
  end;
end;

function TOndemandFormX.FindStrInResult(substr:string): Boolean;
var sx:TStringList;
    str:string;
    col,row,pos1:integer;
begin
  sx:=TStringList.Create;
  sx.Clear;
  try
    for row:=1 to G2.RowCount-1 do
    begin
      pos1:=pos(substr,G2.Cells[1,row]);
      if pos1<=0 then continue;
      str:=format('%s?%s',[G2.Cells[0,row],G2.Cells[1,row]]);
      S1.Add(str);
    end;
    for row:=1 to G2.RowCount-1 do G2.Rows[row].Clear;
    G2.RowCount:=S1.Count+1;
    for row:=0 to S1.Count-1 do
    begin
      str:=S1.Strings[row];
      pos1:=pos('?',str);
      G2.Cells[0,row+1]:=copy(str,1,pos1-1);
      delete(str,1,pos1);
      G2.Cells[1,row+1]:=str;
    end;
  finally
    sx.Free;
  end;
end;

end.