⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 本系统在一些大中型企业(跨多达24个区域)一直都在很好的服务过
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, lmdctrl, Lmdsplta, ExtCtrls, StdCtrls, FileCtrl, Buttons,
  Grids, DBGrids, Db, DBClient,  DBTables,
  Tabnotbk, Menus, FlyingOp, cmpGFXComboBox, lmdstdcS, TB97,
  wwdbdatetimepicker,Fmxutils;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Panel2: TPanel;
    LMD3PaneSplitCtrl1: TLMD3PaneSplitCtrl;
    Panel3: TPanel;
    Panel4: TPanel;
    FileListBox1: TFileListBox;
    DataSource1: TDataSource;
    DirectoryListBox1: TDirectoryListBox;
    DirectoryListBox2: TDirectoryListBox;
    DirectoryListBox3: TDirectoryListBox;
    ClientDataSet1: TClientDataSet;
    DataSource2: TDataSource;
    Table1: TTable;
    DataSource3: TDataSource;
    BatchMove1: TBatchMove;
    Table2: TTable;
    Panel10: TPanel;
    BitBtn1: TBitBtn;
    BitBtn9: TBitBtn;
    ProgressBar1: TProgressBar;
    Label2: TLabel;
    Panel11: TPanel;
    TabbedNotebook1: TTabbedNotebook;
    Panel9: TPanel;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Panel12: TPanel;
    Image1: TImage;
    FlyingOp1: TFlyingOp;
    N2: TMenuItem;
    PopupMenu2: TPopupMenu;
    N3: TMenuItem;
    N4: TMenuItem;
    ImageList1: TImageList;
    Memo1: TMemo;
    N5: TMenuItem;
    N6: TMenuItem;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton4: TSpeedButton;
    PopupMenu3: TPopupMenu;
    N15: TMenuItem;
    N16: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N22: TMenuItem;
    N7: TMenuItem;
    Toolbar971: TToolbar97;
    Panel13: TPanel;
    link: TLabel;
    Image6: TImage;
    SpeedButton16: TSpeedButton;
    Sendbt: TSpeedButton;
    Panel14: TPanel;
    Dock971: TDock97;
    MainMenu1: TMainMenu;
    O1: TMenuItem;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    N31: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    G1: TMenuItem;
    MenuItem7: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    H1: TMenuItem;
    N32: TMenuItem;
    ComboBox1: TGFXComboBox;
    Panel7: TPanel;
    DirectoryListBox4: TDirectoryListBox;
    Panel8: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    DateTimePicker1: TDateTimePicker;
    BitBtn3: TBitBtn;
    FileListBox2: TFileListBox;
    Image2: TImage;
    SpeedButton10: TSpeedButton;
    SpeedButton12: TSpeedButton;
    Image3: TImage;
    Panel5: TPanel;
    Panel6: TPanel;
    FileListBox3: TFileListBox;
    DirectoryListBox5: TDirectoryListBox;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N17: TMenuItem;
    PopupMenu4: TPopupMenu;
    N23: TMenuItem;
    N36: TMenuItem;
    N37: TMenuItem;
    N38: TMenuItem;
    N39: TMenuItem;
    bkstyle: TLabel;
    SpeedButton13: TSpeedButton;
    X1: TMenuItem;
    N40: TMenuItem;
    N8: TMenuItem;
    SQL1: TMenuItem;
    initpanel: TPanel;
    nameLabel: TLabel;
    superLabel: TLabel;
    hostsiteLabel: TLabel;
    ftppassLabel: TLabel;
    ftpuserLabel: TLabel;
    datpassLabel: TLabel;
    datuserLabel: TLabel;
    skyjyLabel: TLabel;
    skyfsjyLabel: TLabel;
    skydqjyLabel: TLabel;
    skyeditorjyLabel: TLabel;
    skyeditorjsjyLabel: TLabel;
    skyeditorfsjyLabel: TLabel;
    skyeditortjjyLabel: TLabel;
    skynetjyLabel: TLabel;
    SkyServerjyLabel: TLabel;
    SkyServer01jyLabel: TLabel;
    SkyServer02jyLabel: TLabel;
    localLabel: TLabel;
    registryLabel: TLabel;
    SkyServer03jyLabel: TLabel;
    SkyServer04jyLabel: TLabel;
    SkyServer05jyLabel: TLabel;
    SkyServer06jyLabel: TLabel;
    EditorServerjyLabel: TLabel;
    ftpjylabel: TLabel;
    ftpszjylabel: TLabel;
    ftpxjwjjjylabel: TLabel;
    ftpxzjylabel: TLabel;
    ftpscjylabel: TLabel;
    sqljy: TLabel;
    nssqljy: TLabel;
    WinArchiverjyLabel: TLabel;
    WinFtpJyLabel: TLabel;
    SkyImagejyLabel: TLabel;
    fileexist: TLabel;
    readsysdat: TLabel;
    dbuserlabel: TLabel;
    dbpasslabel: TLabel;
    ClientDataSet2: TClientDataSet;
    Image5: TImage;
    N9: TMenuItem;
    N10: TMenuItem;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Splitter3: TSplitter;
    Panel16: TPanel;
    Panel15: TPanel;
    RomoteListView: TListView;
    SpeedButton3: TSpeedButton;
    SpeedButton5: TSpeedButton;
    popaddtoserver: TMenuItem;
    N11: TMenuItem;
    sbtRresh: TSpeedButton;
    procedure ComboBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FileListBox1Click(Sender: TObject);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
   
    procedure BitBtn3Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
   
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn9Click(Sender: TObject);
    procedure N1Click(Sender: TObject);

    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure DataSource2DataChange(Sender: TObject; Field: TField);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure FileListBox2Click(Sender: TObject);
    procedure SpeedButton16Click(Sender: TObject);
    procedure SpeedButton17Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure PopupMenu2Popup(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure PopupMenu4Popup(Sender: TObject);
    procedure FileListBox3DblClick(Sender: TObject);
    procedure N37Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N36Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure SendbtClick(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure X1Click(Sender: TObject);
    procedure N40Click(Sender: TObject);
    procedure MenuItem4Click(Sender: TObject);
    procedure MenuItem7Click(Sender: TObject);
    procedure N28Click(Sender: TObject);

    procedure N32Click(Sender: TObject);
    procedure N26Click(Sender: TObject);
    procedure Image7Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure sbtRreshClick(Sender: TObject);
  private
    MsExcel:Variant;
     MsExcelWorkBook:Variant;
     MsExcelWorkSheet:Variant;
    { Private declarations }
  public
  procedure append;
  procedure CHJO;
  procedure InitSyaDat;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Reabout,Unit2,comobj, Unit5, Unit6, Unit8, Unit9, Unit10, Unit11,
  ipdress;

{$R *.DFM}
var dir:string;

 fname : pchar;
 tempp: string;
 cmp: array[0..255] of Char;


procedure TForm1.ComboBox1Change(Sender: TObject);
begin
    ClientDataSet1.Close;
    table1.Close;
    DirectoryListBox1.Directory:=dir+'dat\cdx0'+inttostr(ComboBox1.ItemIndex+1);
    DirectoryListBox2.Directory:=dir+'dat\db0'+inttostr(ComboBox1.ItemIndex+1);
    DirectoryListBox5.Directory:=dir+'dat\temp0'+inttostr(ComboBox1.ItemIndex+1);

    if (ComboBox1.ItemIndex+1)=1 then
    begin
       if Uppercase(skyServer01jyLabel.Caption)='TRUE' then
         begin
           showmessage('系统检测到你没有此权限使用此功能!');
           close;
         end;
    end;

    if (ComboBox1.ItemIndex+1)=2 then
    begin
       if Uppercase(skyServer02jyLabel.Caption)='TRUE' then
         begin
           showmessage('系统检测到你没有此权限使用此功能!');
           close;
         end;
    end;

    if (ComboBox1.ItemIndex+1)=3 then
    begin
       if Uppercase(skyServer03jyLabel.Caption)='TRUE' then
         begin
           showmessage('系统检测到你没有此权限使用此功能!');
           close;
         end;
    end;

    if (ComboBox1.ItemIndex+1)=4 then
    begin
       if Uppercase(skyServer04jyLabel.Caption)='TRUE' then
         begin
           showmessage('系统检测到你没有此权限使用此功能!');
           close;
         end;
    end;

    if (ComboBox1.ItemIndex+1)=5 then
    begin
       if Uppercase(skyServer05jyLabel.Caption)='TRUE' then
         begin
           showmessage('系统检测到你没有此权限使用此功能!');
           close;
         end;
    end;

    if (ComboBox1.ItemIndex+1)=6 then
    begin
       if Uppercase(skyServer06jyLabel.Caption)='TRUE' then
         begin
           showmessage('系统检测到你没有此权限使用此功能!');
           close;
         end;
    end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   InitSyaDat;
  DateTimePicker1.Date:=date;
  dir:=extractFilePath(ParamStr(0)) ;
  LMD3PaneSplitCtrl1.Splitter2.Position:=228;
  try
  forcedirectories(dir+'bakup');
  forcedirectories(dir+'dat');
  forcedirectories(dir+'dat\db01');
  forcedirectories(dir+'dat\db02');
  forcedirectories(dir+'dat\db03');
  forcedirectories(dir+'dat\db04');
  forcedirectories(dir+'dat\db05');
  forcedirectories(dir+'dat\db06');
  forcedirectories(dir+'dat\cdx02');
  forcedirectories(dir+'dat\cdx03');
  forcedirectories(dir+'dat\cdx04');
  forcedirectories(dir+'dat\cdx05');
  forcedirectories(dir+'dat\cdx06');
  forcedirectories(dir+'dat\cdx01');
  forcedirectories(dir+'dat\temp01');
  forcedirectories(dir+'dat\temp02');
  forcedirectories(dir+'dat\temp03');
  forcedirectories(dir+'dat\temp04');
  forcedirectories(dir+'dat\temp05');
  forcedirectories(dir+'dat\temp06');
  forcedirectories(dir+'dat\dat');




  memo1.Lines.Clear;
  {==}

  combobox1.Items.Clear;
  memo1.Lines.LoadFromFile('c:\newstar\Config\name1.dat');
  combobox1.Items.Add(memo1.Lines.Text);
  combobox1.ImageIndex[0]:=0;
  {==}

  memo1.Lines.LoadFromFile('c:\newstar\Config\name2.dat');
  combobox1.Items.Add(memo1.Lines.Text);
   combobox1.ImageIndex[1]:=0;
{==}

  memo1.Lines.LoadFromFile('c:\newstar\Config\name3.dat');
  combobox1.Items.Add(memo1.Lines.Text);
   combobox1.ImageIndex[2]:=0;
{==}

  memo1.Lines.LoadFromFile('c:\newstar\Config\name4.dat');
  combobox1.Items.Add(memo1.Lines.Text);
   combobox1.ImageIndex[3]:=0;
{==}

  memo1.Lines.LoadFromFile('c:\newstar\Config\name5.dat');
  combobox1.Items.Add(memo1.Lines.Text);
   combobox1.ImageIndex[4]:=0;
{==}

  memo1.Lines.LoadFromFile('c:\newstar\Config\name6.dat');
  combobox1.Items.Add(memo1.Lines.Text);
   combobox1.ImageIndex[5]:=0;
  combobox1.ItemIndex:=0;
  combobox1.OnChange(nil);
  except
  end;

end;

procedure TForm1.FileListBox1Click(Sender: TObject);
begin
TabbedNotebook1.ActivePage:='          源数据报表          ';
if   FileListBox1.FileName<>'' then
begin
   ClientDataSet1.Close;
   ClientDataSet1.LoadFromFile(FileListBox1.FileName);
   ClientDataSet1.Open;
   form1.Caption:='@NewStar信息服务器接收系统-['+filelistbox1.FileName;
   StatusBar1.Panels[1].text:='    '+ExtractFileName(filelistbox1.FileName);
end;


end;

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
    StatusBar1.Panels[1].text:=inttostr(ClientDataSet1.RecNo);
end;







procedure TForm1.BitBtn3Click(Sender: TObject);
var
ret:integer;
begin
if  filelistbox2.FileName<>'' then
begin
ret:=application.MessageBox(pchar('数据报表将全部追加你所选的数据表'+filelistbox2.FileName+'中!'),'追加数据记录',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
panel10.Left:=(form1.Width-panel10.Width) div 2;
panel10.Top:=(form1.Height-panel10.Height) div 2;
panel11.Left:=((form1.Width-panel10.Width) div 2)+8;
panel11.Top:=((form1.Height-panel10.Height) div 2)+6;
panel10.Visible:=true;
panel11.Visible:=true;
end;
end;
end;

procedure Tform1.append;
var i:integer;
j:integer;
begin
ProgressBar1.Max:=filelistbox1.Items.Count;
ProgressBar1.Position:=0;
{==============}
table2.Close;
table2.DatabaseName:='';
table2.TableName:=filelistbox2.FileName;
table2.Open;
{=================}
for i:=0 to filelistbox1.Items.Count-1 do
begin
ProgressBar1.Position:=i+1;
clientdataset1.Close;
clientdataset1.LoadFromFile(DirectoryListBox1.Directory+'\'+FileListBox1.Items.Strings[i]);
clientdataset1.Open;
clientdataset1.First;
{=================}
 while not   clientdataset1.EOF do
      begin
      for j:=0  to clientdataset1.FieldDefs.Count-1 do
       begin
         if   (clientdataset1.FieldDefs.Items[j].DataType =ftinteger) or  (clientdataset1.FieldDefs.Items[j].DataType =ftsmallint) then
           begin
       if   clientdataset1.Fields[j].Value<0   then
         begin
         clientdataset1.Edit;
        clientdataset1.Fields[j].Value:=0;

         end;

           end;
       end;
      clientdataset1.Next;
      end;
{=================}

CHJO;
end;
end;



procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
LMD3PaneSplitCtrl1.Splitter2.Position:=228;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
LMD3PaneSplitCtrl1.Splitter2.Position:=0;
end;



procedure Tform1.CHJO;
var i:integer;
begin
     { filename.Lines.Clear;
      filetype.Lines.Clear;
      filesize.Lines.Clear;}

      table1.Close;
      table1.FieldDefs.Clear;


     for i:=0 to  clientdataset1.FieldCount-1 do
      begin
      if   clientdataset1.FieldDefs.Items[i].DataType   =ftsmallint then
           begin
             {filetype.Lines.Add('ftsmallint');}
             table1.FieldDefs.Add(clientdataset1.FieldDefs.Items[i].Name,ftsmallint,0,false);

           end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -