main.pas

适合Delphi初学者使用。其中涉及XML文件导入

    bRemark := iniFile.ReadBool(gUserInfo.sTitle, 'ExcelRemark', False);
    iName := iniFile.ReadInteger(gUserInfo.sTitle, 'ExcelNameCol', 2);
    iVip := iniFile.ReadInteger(gUserInfo.sTitle, 'ExcelVIPCol', 1);
    iTel := iniFile.ReadInteger(gUserInfo.sTitle, 'ExcelTelCol', 5);
    iRemark := iniFile.ReadInteger(gUserInfo.sTitle, 'ExcelRemarkCol', 9);
    iniFile.Free;
    try
      ExcelWorkBook1.ConnectTo(ExcelApplication1.Workbooks.Open(sFileName, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, 0));
      ExcelWorkSheet1.ConnectTo(ExcelWorkBook1.Worksheets[iNo] as _Worksheet);
      iCount := ExcelWorkSheet1.UsedRange[0].Rows.Count;
      DM.QueCustomer.Filtered := False;
      for i := iRow to iCount do
      begin
        sTemp := Trim(ExcelWorksheet1.Cells.Item[i, iVip]);
        if sTemp = '' then
        begin
          Continue;
        end;
        if DM.QueCustomer.Locate('VIP', sTemp, [loCaseInsensitive]) then
        begin
          DM.QueCustomer.Edit;
        end
        else
        begin
          DM.QueCustomer.Append;
        end;
        DM.QueCustomer.FieldByName('VIP').AsString := sTemp;
        DM.QueCustomer.FieldByName('Shop').AsString := gUserInfo.sCustomer;
        sTemp := Trim(ExcelWorksheet1.Cells.Item[i, iName]);
        if sTemp = '' then
        begin
          DM.QueCustomer.Cancel;
          Continue;
        end;
        DM.QueCustomer.FieldByName('Name').AsString := sTemp;
        if bTel then
        begin
          sTemp := Trim(ExcelWorksheet1.Cells.Item[i, iTel]);
          if sTemp <> '' then
          begin
            DM.QueCustomer.FieldByName('Tel').AsString := sTemp;
          end;
        end;

        if bRemark then
        begin
          sTemp := Trim(ExcelWorksheet1.Cells.Item[i, iRemark]);
          if sTemp <> '' then
          begin
            DM.QueCustomer.FieldByName('Remark').AsString := sTemp;
          end;
        end;

        DM.QueCustomer.Post;
      end;
    except

    end;
  finally
    Screen.Cursor := crDefault;
    ExcelApplication1.Quit;
    ExcelWorksheet1.Disconnect;
    ExcelWorkbook1.Disconnect;
    ExcelApplication1.Disconnect;
  end;
end;

type
  TClient = record
    Name: string;
    VIP: string;
    Tel: string;
  end;

procedure TfrmMain.pmImportOldDocClick(Sender: TObject);
var
  sFileName: string;
  Root: IXMLNode; //指向XML根结点
  Parent_Node: IXMLNode; //指向学生结点
  Child_node: IXMLNode; //指向学生的子结点
  Customer: TClient; //存单个学生信息
  i: integer; //循环变量
begin
  sFileName := '';
  with TOpenDialog.Create(Self) do
  begin
    Title := '选择原系统文件夹下的Record.xml文件';
    Filter := 'XML 文件(*.xml)|*.xml';
    FileName := 'Record.xml';
    if Execute then
    begin
      sFileName := FileName;
    end;
    Free;
  end;
  if sFileName = '' then
  begin
    Exit;
  end;
  InXMLDoc.LoadFromFile(sFileName); //调入Input.xml文件
  Root := InXMLDoc.DocumentElement; //取XML文件的根结点，即“＜学生花名册＞”
  Parent_Node := Root.ChildNodes.First; //使Parent_Node指向学客户结点
  //Memo1.Lines.Clear;
  i := 1;
  DM.QueCustomer.Filtered := False;
  while (Parent_Node <> nil) do //循环取多个客户，可再多加几个学生信息测试
  begin
    if (Parent_Node.NodeName = 'Table1') then //判断是否为客户结点
    begin
      //Student := TStudent.Create; //新建一个客户的结构信息
      //Student.sex := Parent_Node.Attributes['性别']; //取客户的性别属性
      Child_Node := Parent_Node.ChildNodes.First;
//使Child_Node指向该客户的第一个子结点信息
      Customer.Name := '';
      while (Child_Node <> nil) do //循环取客户的各个子各点
      begin
        if (Child_Node.NodeName = 'Client') then //判断是否为姓名结点
          Customer.name := Child_Node.Text //取姓名结点的值，取于name字段中
        else if (Child_Node.NodeName = 'Money') then //原资料有误，将Money当成VIP
          Customer.VIP := Child_Node.Text
        else if (Child_Node.NodeName = 'Tel') then
          Customer.Tel := Child_Node.Text;
        Child_Node := Child_Node.NextSibling; //顺序取下一个学生的子结点信息
      end;
      if Customer.Name <> '' then
      begin
        //Memo1.Lines.Add(IntToStr(i)+';'+Student.Name+';'+Student.Money+';'+Student.Tel);
        if DM.QueCustomer.Locate('VIP', Customer.VIP, [loCaseInsensitive]) then
        begin
          DM.QueCustomer.Edit;
        end
        else
        begin
          DM.QueCustomer.Append;
        end;
        DM.QueCustomer.FieldByName('VIP').AsString := Customer.VIP;
        DM.QueCustomer.FieldByName('Shop').AsString := gUserInfo.sCustomer;
        DM.QueCustomer.FieldByName('Name').AsString := Customer.Name;
        DM.QueCustomer.FieldByName('Tel').AsString := Customer.Tel;
        DM.QueCustomer.Post;
      end;
      //List.Add(Student); //把一个学生信息加入列表
    end;
    Parent_Node := Parent_Node.NextSibling; //顺序取下一个学生信息
  end;
end;

procedure TfrmMain.btnAddClick(Sender: TObject);
var
  iID: Integer;
begin
  if DM.QueCustomer.RecordCount > 0 then
  begin
    iID := DM.QueCustomer.FieldByName('ID').AsInteger;
    DM.QueCustomer.Last;
    if iID = DM.QueCustomer.FieldByName('ID').AsInteger then
    begin
      DM.QueCustomer.Append;
    end
    else
    begin
      DM.QueCustomer.Locate('ID', iID, [loCaseInsensitive]);
      DM.QueCustomer.Next;
      DM.QueCustomer.Insert;
    end;

  end
  else
  begin
    DM.QueCustomer.Append;
  end;
  DM.QueCustomer.FieldByName('Shop').AsString := gUserInfo.sCustomer;
end;

procedure TfrmMain.btnFirstClick(Sender: TObject);
begin
  if DM.QueCustomer.RecordCount > 0 then
  begin
    DM.QueCustomer.First;
  end;
end;

procedure TfrmMain.btnLastClick(Sender: TObject);
begin
  if DM.QueCustomer.RecordCount > 0 then
  begin
    DM.QueCustomer.Last;
  end;
end;

procedure TfrmMain.pmFirstColorClick(Sender: TObject);
begin
  with TColorDialog.Create(Self) do
  begin
    Color := FIRSTCOLOR;
    if Execute then
    begin
      FIRSTCOLOR := Color;
      ReadInifileInteger('FIRSTCOLOR', FIRSTCOLOR, 2);
    end;
  end;
end;

procedure TfrmMain.pmSecondColorClick(Sender: TObject);
begin
  with TColorDialog.Create(Self) do
  begin
    Color := SECOUNDCOLOR;
    if Execute then
    begin
      SECOUNDCOLOR := Color;
      ReadInifileInteger('SECOUNDCOLOR', SECOUNDCOLOR, 2);
    end;
  end;
end;

procedure TfrmMain.pmExportExcelClick(Sender: TObject);
begin
  DBGridEhExport(gridCustomer);
end;

procedure TfrmMain.pmExportFileClick(Sender: TObject);
var
  sFileName: string;
  mem: TMemoryStream;
  tempmem: TMemoryStream;
  sTableName: string[32];
  iSize: Int64;
begin
  sFileName := '';
  with TSaveDialog.Create(Self) do
  begin
    Title := '选择资料保存的文件名';
    Filter := '资料文件(*.info)|*.info';
    FileName := gUserInfo.sCustomer + '.info';
    if Execute then
    begin
      sFileName := FileName;
    end;
    Free;
  end;
  if sFileName = '' then
  begin
    Exit;
  end;
  if Pos('.info', sFileName) < 1 then
  begin
    sFileName := sFileName + '.info';
  end;
  DM.QueCustomer.Filtered := False;
  mem := TMemoryStream.Create;
  mem.Position := 0;
  sTableName := gUserInfo.sCustomer;
  mem.Write(sTableName, SizeOf(sTableName));
  SaveADOQueryToStream(DM.QueCustomer, mem);
  //SaveOtherADOQuery(mem, tempmem);
  tempmem := TMemoryStream.Create;
  CompressionStream(mem, tempmem);
  tempmem.SaveToFile(sFileName);
  mem.Free;
  tempmem.Free;
  Application.MessageBox('保存完成！', '提示', MB_OK + MB_ICONINFORMATION);
end;

procedure TfrmMain.pmImportFileClick(Sender: TObject);
var
  sFileName: string;
  mem: TMemoryStream;
  tempmem: TMemoryStream;
  sTableName: string[32];
  tempFileName: string;
  ii, iCount: Integer;
  sFieldName: string;
  bExistID: Boolean;
  //MemTableInfo: TMemTableEh;
  iNewID: Integer;
begin
  sFileName := '';
  with TOpenDialog.Create(Self) do
  begin
    Title := '选择资料更新的文件名';
    Filter := '资料文件(*.info)|*.info';
    if Execute then
    begin
      sFileName := FileName;
    end;
    Free;
  end;
  if sFileName = '' then
  begin
    Exit;
  end;
  mem := TMemoryStream.Create;
  tempmem := TMemoryStream.Create;
  tempmem.LoadFromFile(sFileName);
  DeCompressionStream(tempmem, mem);
  tempmem.Free;
  mem.Position := 0;
  mem.Read(sTableName, SizeOf(sTableName));
  if sTableName <> gUserInfo.sCustomer then
  begin
    if Application.MessageBox(PChar('不是相应的资料(目前是 ' + gUserInfo.sCustomer + ' ,而文件资料则为 ' + sTableName + '),' + #13#10
      + '继续导入吗？：'), PChar('警告'), MB_YESNO) = IDNo then
    begin
      mem.Free;
      Exit;
    end;

  end;
  Screen.Cursor := crHourGlass;
  DM.dsCustomer.DataSet := nil;
  DM.QueCustomer.Filtered := False;
  DM.QueTmp.Close;
  mem.Seek(SizeOf(sTableName), soFromBeginning);
  GetADOQueryFromStream(DM.QueTmp, mem);

  if DM.QueTmp.RecordCount > 0 then
  begin
    DM.QueTmp.First;
    iCount := DM.QueCustomer.FieldCount;
    while not DM.QueTmp.Eof do
    begin
      if not DM.QueCustomer.Locate('VIP',
        DM.QueTmp.FieldByName('VIP').AsString, [loCaseInsensitive]) then
      begin
        //bExistID := DM.QueCustomer.Locate('ID', DMgenCon.QueTmp.FieldByName('ID').AsInteger, []);
        DM.QueCustomer.Append;
        //MemTableInfo.Append;
        for ii := 1 to iCount - 1 do
        begin
          sFieldName := DM.QueCustomer.Fields[ii].FieldName;
          if DM.QueCustomer.FieldByName(sFieldName).FieldKind = fkData then
          begin
            DM.QueCustomer.FieldByName(sFieldName).AsVariant :=
              DM.QueTmp.FieldByName(sFieldName).AsVariant;
          end;


        end;
        DM.QueCustomer.FieldByName('Shop').AsString := gUserInfo.sCustomer;
        DM.QueCustomer.Post;

      end
      else
      begin

      end;
      Application.ProcessMessages;
      DM.QueTmp.Next;
    end;
  end;

  DM.dsCustomer.DataSet := DM.QueCustomer;
  mem.Free;

  //MemTableInfo.Free;
  Screen.Cursor := crDefault;
  //ADOQuery1.Requery();
  Application.MessageBox('资料更新完成！', '提示', MB_OK + MB_ICONINFORMATION);
  //DMgenCon.QueTmp
end;

procedure TfrmMain.btnReLoginClick(Sender: TObject);
begin
  if TfrmLogin.ShowForm then
  begin
    InitData;
    InitButton;
  end;
end;

procedure TfrmMain.btnShopAdminClick(Sender: TObject);
begin
  TfrmInfoShop.ShowForm;
  InitData;
end;

procedure TfrmMain.btnTurnShopClick(Sender: TObject);
var
  sName: string;
  iID: Integer;
begin
  sName := DM.QueCustomer.FieldByName('Shop').AsString;
  if TfrmTurnShop.ShowForm(sName) then
  begin
    DM.QueCustomer.Edit;
    DM.QueCustomer.FieldByName('Shop').AsString := DM.QueShop.FieldByName('Name').AsString;
    DM.QueCustomer.Post;
    iID := -1;
    DM.QueCustomer.Next;
    if not DM.QueCustomer.Eof then
    begin
      iID := DM.QueCustomer.FieldByName('ID').AsInteger;
    end;
    DM.QueCustomer.Requery();
    if iID > 0 then
    begin
      DM.QueCustomer.Locate('ID', iID, []);
    end
    else
    begin
      DM.QueCustomer.First;
    end;
  end;
end;

procedure TfrmMain.pmExcelSetClick(Sender: TObject);
begin
  TfrmExcelImportColSet.ShowForm;
end;

procedure TfrmMain.pmDelSpaceClick(Sender: TObject);
var
  iID: Integer;
begin
  DM.QueCustomer.Filtered := False;
  if DM.QueCustomer.RecordCount = 0 then
  begin
    Exit;
  end;
  iID := DM.QueCustomer.FieldByName('ID').AsInteger;
  DM.QueCustomer.First;
  while not DM.QueCustomer.Eof do
  begin
    DM.QueCustomer.Edit;
    DM.QueCustomer.FieldByName('Name').AsString := GetDelSpaceStr(DM.QueCustomer.FieldByName('Name').AsString);
    DM.QueCustomer.FieldByName('VIP').AsString := GetDelSpaceStr(DM.QueCustomer.FieldByName('VIP').AsString);
    //DM.QueCustomer.FieldByName('Shop').AsString := gUserInfo.sCustomer;
    
    DM.QueCustomer.FieldByName('Tel').AsString := GetDelSpaceStr(DM.QueCustomer.FieldByName('Tel').AsString);
    DM.QueCustomer.FieldByName('Remark').AsString := GetDelSpaceStr(DM.QueCustomer.FieldByName('Remark').AsString);
    DM.QueCustomer.Post;
    DM.QueCustomer.Next;
  end;
  DM.QueCustomer.Locate('ID', iID, []);
end;

end.