InputOutput（Excel导入导出）

unit InputOutput;

interface

Uses
  DB, Classes, Dialogs, ABSMain, ComObj, Variants, PublicFunctionUnit,
  Graphics;

var
  CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
  CXlsEof: array[0..1] of Word = ($0A, 00);
  CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
  CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);
  CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);

Type
  TProgressEvent = procedure (aPercent: Integer) of object;

  TOutPut = Class(TObject)
  Private
    FCol: word;
    FRow: word;
    FDataSet: TDataSet;
    QryOutput: TABSQuery;
    Stream: TStream;
    FWillWriteHead: boolean;
    FBookMark: TBookmark;
    procedure IncColRow;
    procedure WriteBlankCell;
    procedure WriteFloatCell(const AValue: Double);
    procedure WriteIntegerCell(const AValue: Integer);
    procedure WriteStringCell(const AValue: string);
    procedure WritePrefix;
    procedure WriteSuffix;
    procedure WriteTitle;
    procedure WriteDataCell;

    procedure Save2Stream(aStream: TStream);
  Public
    procedure Save2File(FileName: string; WillWriteHead: Boolean);
    procedure Save2DiaFile(WillWriteHead: Boolean);
    procedure OutToExcel(const UseID: Integer);
    function HaveExcel: Boolean;
    Constructor Create(aDataSet, qrysave: TDataSet);
  end;

  TInPut = Class(TObject)
  private
    qrysave: TABSQuery;
    qrygroup: TABSQuery;
  public
    procedure LoadFromExcel(const UseID: Integer; aProgress: TProgressEvent);
    procedure AddGroup(const groupname: string; UseID: Integer);                                 // 增加分组
    procedure AddLinkMan(const groupname, linkname, linknumber, remark: string; UseID: Integer); // 增加联系人
    function HaveExcel: Boolean;                                                                 // 机器上是否安装Excel
    function IsHaveTheLinkman(const groupname, linkname, linknumber, remark: string; UseID: Integer): Boolean;  // 判断是否含有此联系人
    function GetTheGroupId(const groupname: string; UseID: Integer): Integer;                    // 取分组ID
    procedure ChecktheNumber(strlst: TStringList; var re: TStringList);
    constructor Create(DataSet1, DataSet2: TDataSet);

  end;

implementation

uses SysUtils, frmPlatClientMain;

{ TOutPut }

Constructor TOutPut.Create(aDataSet, qrysave: TDataSet);
begin
 inherited Create;
 FDataSet := aDataSet;
 QryOutput := qrysave as TABSQuery;
end;

procedure TOutPut.IncColRow;
begin
 if FCol = FDataSet.FieldCount - 1 then
 begin
   Inc(FRow);
   FCol :=0;
 end
 else
   Inc(FCol);
end;

procedure TOutPut.WriteBlankCell;
begin
 CXlsBlank[2] := FRow;
 CXlsBlank[3] := FCol;
 Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
 IncColRow;
end;

procedure TOutPut.WriteFloatCell(const AValue: Double);
begin
 CXlsNumber[2] := FRow;
 CXlsNumber[3] := FCol;
 Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
 Stream.WriteBuffer(AValue, 8);
 IncColRow;
end;

procedure TOutPut.WriteIntegerCell(const AValue: Integer);
var
 V: Integer;
begin
 CXlsRk[2] := FRow;
 CXlsRk[3] := FCol;
 Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
 V := (AValue shl 2) or 2;
 Stream.WriteBuffer(V, 4);
 IncColRow;
end;

procedure TOutPut.WriteStringCell(const AValue: string);
var
 L: Word;
begin
 L := Length(AValue);
 CXlsLabel[1] := 8 + L;
 CXlsLabel[2] := FRow;
 CXlsLabel[3] := FCol;
 CXlsLabel[5] := L;
 Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
 Stream.WriteBuffer(Pointer(AValue)^, L);
 IncColRow;
end;

procedure TOutPut.WritePrefix;
begin
 Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;

procedure TOutPut.WriteSuffix;
begin
 Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;

procedure TOutPut.WriteTitle;
var
 n: word;
begin
 for n := 0 to FDataSet.FieldCount - 1 do
   WriteStringCell(FDataSet.Fields[n].FieldName);
end;

procedure TOutPut.WriteDataCell;
var
 n: word;
begin
 WritePrefix;
 if FWillWriteHead then WriteTitle;
 FDataSet.DisableControls;
 FBookMark := FDataSet.GetBookmark;
 FDataSet.First;
 while not FDataSet.Eof do
 begin
   for n := 0 to FDataSet.FieldCount - 1 do
   begin
     if FDataSet.Fields[n].IsNull then
       WriteBlankCell
     else begin
       case FDataSet.Fields[n].DataType of
         ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
             WriteIntegerCell(FDataSet.Fields[n].AsInteger);
         ftFloat, ftCurrency, ftBCD:
             WriteFloatCell(FDataSet.Fields[n].AsFloat);
       else
         WriteStringCell(FDataSet.Fields[n].AsString);
       end;
     end;
   end;
   FDataSet.Next;
 end;
 WriteSuffix;
 if FDataSet.BookmarkValid(FBookMark) then FDataSet.GotoBookmark(FBookMark);
 FDataSet.EnableControls;
end;

procedure TOutPut.Save2Stream(aStream: TStream);
begin
 FCol := 0;
 FRow := 0;
 Stream := aStream;
 WriteDataCell;
end;

procedure TOutPut.Save2File(FileName: string; WillWriteHead: Boolean);
var
 aFileStream: TFileStream;
begin
 FWillWriteHead := WillWriteHead;
 if FileExists(FileName) then DeleteFile(FileName);
 aFileStream := TFileStream.Create(FileName, fmCreate);
 Try
   Save2Stream(aFileStream);
 Finally
   aFileStream.Free;
 end;
end;

procedure TOutPut.Save2DiaFile(WillWriteHead: Boolean);
var
 SaveDialog1: TSaveDialog;
begin
 SaveDialog1 := TSaveDialog.Create(nil);
 SaveDialog1.DefaultExt := '.xls';
 Try
   SaveDialog1.Filter := 'Excel文档|*.xls';
//   SaveDialog1.InitialDir := 'D:/';
   if not SaveDialog1.Execute then exit;
   Save2File(SaveDialog1.FileName, WillWriteHead);
   ShowMessage('导出完成!');
 Finally
   SaveDialog1.Free;
 end;
end;

function TOutPut.HaveExcel: Boolean;
var
  re: Boolean;
  ExcelApp: Variant;
begin
  re := False;
  try
    ExcelApp := CreateOleObject('Excel.Application');
    re := True;
    ExcelApp.Quit;
    ExcelApp := UnAssigned;
  except
    re := False;
  end;
  Result := re;     
end;

procedure TOutPut.OutToExcel(const UseID: Integer);
begin
  with QryOutput do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select sendaddresslist.groupname as ' + QuotedStr('联系人分组') + ', senderlinkman.linkname ');
    SQL.Add('as ' + QuotedStr('联系人名称') + ', senderlinkman.linknumber as ' + QuotedStr('联系人号码') + ',');
    SQL.Add('senderlinkman.remark as ' + QuotedStr('联系人备注') + ' from senderlinkman, sendaddresslist ');
    SQL.Add('where sendaddresslist.id = senderlinkman.groupin and UseID = :ui');
    Params.FindParam('ui').Value := UseID;
    Open;
  end;
  Save2DiaFile(True);
end;

{ TInPut }

procedure TInPut.AddGroup(const groupname: string; UseID: Integer);
begin
  try
    with qrysave do
    begin
      Close;
      SQL.Clear;
      SQL.Add('insert into sendaddresslist (UseID, groupname) values (:ui, :gn)');
      Params.FindParam('ui').Value := UseID;
      Params.FindParam('gn').Value := groupname;
      ExecSQL;
    end;
  except
    on e: Exception do
   
  end;
end;

procedure TInPut.AddLinkMan(const groupname, linkname, linknumber,
  remark: string; UseID: Integer);
var
  groupin: Integer;
  number: string;
begin
  groupin := GetTheGroupId(groupname, UseID);
  if (Length(Trim(groupname)) > 0) and (Length(Trim(linkname)) > 0) and (Length(Trim(linknumber)) > 0) then
  if (Trim(groupname) <> '联系人分组') and (Trim(linkname) <> '联系人名称') and (Trim(linknumber) <> '联系人号码') and (Trim(remark) <> '联系人备注') then
  begin
    if groupin = -1 then
      AddGroup(groupname, UseID);
    groupin := GetTheGroupId(groupname, UseID);
    if Pos('-', linknumber) > 0 then
      number :=  Copy(linknumber, 1, Pos('-', linknumber) - 1) + Copy(linknumber, Pos('-', linknumber) + 1, Length(linknumber) - Pos('-', linknumber))
    else
      number := linknumber;
    try
      if not IsHaveTheLinkman(groupname, linkname, number, remark, UseID) then
      with qrysave do
      begin
        Close;
        SQL.Clear;
        SQL.Add('insert into senderlinkman (UseID, groupin, linkname, linknumber, remark) values (:ui, :gi, :ln, :num, :rm)');
        Params.FindParam('ui').Value := UseID;
        Params.FindParam('gi').Value := groupin;
        Params.FindParam('ln').Value := linkname;
        Params.FindParam('num').Value := number;
        Params.FindParam('rm').Value := remark;
        ExecSQL;
      end;
    except
      on e: Exception do
   
    end;
  end;
end;

procedure TInPut.ChecktheNumber(strlst: TStringList; var re: TStringList);
var
  i, j: Integer;
  s: string;
begin
  j := 0;
//  i := 0;
  re.Clear;
  for i := 1 to strlst.Count - 1 do
  begin
    if not CheckTelCodeEdit(strlst[i]) then
    begin
      Inc(j);
      re.Add(IntToStr(i));
    end;
  end;
end;

constructor TInPut.Create(DataSet1, DataSet2: TDataSet);
begin
  inherited Create;
  qrysave := DataSet1 as TABSQuery;
  qrygroup := DataSet2 as TABSQuery;
end;

function TInPut.GetTheGroupId(const groupname: string;
  UseID: Integer): Integer;
var
  re: Integer;
begin
  re := -1;
  try
    with qrygroup do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select id from sendaddresslist where groupname = :gn and UseId = :ui');
      Params.FindParam('gn').Value := groupname;
      Params.FindParam('ui').Value := UseID;
      Open;
      if qrygroup.RecordCount > 0 then
        re := FieldByName('id').AsInteger
      else
        re := -1;
    end;
  except
    on e: Exception do
  end;
  Result := re;
end;

function TInPut.HaveExcel: Boolean;
var
  re: Boolean;
  ExcelApp: Variant;
begin
  re := False;
  try
    ExcelApp := CreateOleObject('Excel.Application');
    re := True;
    ExcelApp.Quit;
    ExcelApp := UnAssigned;
  except
    re := False;
  end;
  Result := re;     
end;

function TInPut.IsHaveTheLinkman(const groupname, linkname, linknumber,
  remark: string; UseID: Integer): Boolean;
var
  re: Boolean;
  groupin: Integer;
begin
  re := False;
  groupin := GetTheGroupId(groupname, UseID);
  if groupin = -1 then
    re := False
  else
  begin
    try
      with qrygroup do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select id from senderlinkman where groupin = :gi and linkname = :ln and linknumber = :num and remark = :rm and UseID = :ui');
        Params.FindParam('gi').Value := groupin;
        Params.FindParam('ln').Value := linkname;
        Params.FindParam('num').Value := linknumber;
        Params.FindParam('rm').Value := remark;
        Params.FindParam('ui').Value := UseID;
        Open;
        if qrygroup.RecordCount > 0 then
          re := True
        else
          re := False;
      end;
    except
      on e: Exception do
     
    end;
  end;
  Result := re;
end;

procedure TInPut.LoadFromExcel(const UseID: Integer; aProgress: TProgressEvent);
var
  Opendialog1: TOpenDialog;
  excelname: string;
  ExcelRowCount, i, j: Integer;
  ExcelApp, WorkBook: Variant;
  numlist, re: TStringList;
begin
  Opendialog1 := TOpenDialog.Create(nil);
  try
    if Opendialog1.Execute then
      excelname := Opendialog1.FileName
    else
      Exit;
  finally
    Opendialog1.Free;
  end;
  try
    ExcelApp := CreateOleObject('Excel.Application');
    WorkBook := ExcelApp.WorkBooks.Open(excelname);
    ExcelApp.Visible := False;
    ExcelRowCount := WorkBook.WorkSheets[1].UsedRange.Rows.Count;
    try
      numlist := TStringList.Create;
      re := TStringList.Create;
      for i := 1 to ExcelRowCount do
      begin
        numlist.Add(ExcelApp.Cells[i, 3].Value);
      end;
      ChecktheNumber(numlist, re);
      if re.Count > 0 then
      begin
        for i := 0 to re.Count - 1 do
        begin
          j := StrToInt(re[i]) + 1;
          ExcelApp.ActiveSheet.Cells[j, 3].Font.Color := clRed;//$0000FF;
        end;
        ExcelApp.DisplayAlerts := False;
        ExcelApp.ActiveWorkbook.Save;
        ShowMessage('通讯录格式不正确');
        Exit;
      end;
    finally
      numlist.Free;
      re.Free;
    end;

    if Assigned(aProgress) then aProgress(0);
    for i := 1 to ExcelRowCount do
    begin
      AddLinkMan(ExcelApp.Cells[i, 1].Value, ExcelApp.Cells[i, 2].Value, ExcelApp.Cells[i, 3].Value, ExcelApp.Cells[i, 4].Value, UseID);
      if Assigned(aProgress) then aProgress(Round(i/ExcelRowCount)*100);
    end;
    if Assigned(aProgress) then aProgress(100);
    ShowMessage('导入完成！');
  finally
//    if not ExcelApp.ActiveWorkBook.Saved then
//      ExcelApp.ActiveSheet.PrintPreview;
    WorkBook.Close;
    ExcelApp.Quit;
    ExcelApp := UnAssigned;
    WorkBook := UnAssigned;
  end;
end;

end.