sldata.pas

三層源碼,DELPHI寫的三層源碼,三層源碼,

unit sldata;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,QRPRNTR,
  Db, DBClient, SConnect, ImgList,StdCtrls,ComCtrls,QuickRpt,printers,
  MConnect,dbgrids;

type
  Tsl_data = class(TDataModule)
    sldcom: TSocketConnection;
    ImageList2: TImageList;
    ImageList1: TImageList;
    querys: TClientDataSet;
    DataSource1: TDataSource;
    querysinfo: TClientDataSet;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    nx:integer;
    pubbitmap:tbitmap;
    procedure writeini;
    procedure readini;
    function  checkresult:boolean;
    function RegisterOleFile (strOleFileName : STRING; OleAction : Byte ) : BOOLEAN;

    { Private declarations }
  public
    procedure  changecolors;
    procedure formonpaint(sender:tform);
    procedure mainimage(bitmap1,bitmap2:tbitmap);
    procedure  setprint(temprint:tquickrep;bearing:boolean);
    ////////////////////////////////////////
    function  getserverdates:tdatetime;
    function  selectdate:tdatetime;

//******************************************************************************
// HTML转换和DBGrid 控制
//******************************************************************************
    function getviewhtml(id:integer;outhtml:tstringlist):boolean;
    procedure autosizedbgrid(dbgrids:tdbgrid);
//******************************************************************************
//系统设置, 打印,公司信息..
//******************************************************************************
    function sysother_model(funid:integer;msg:string):boolean;
    function sfztosheng(s:string):string;
    procedure getcompanyinfo;
//******************************************************************************
//帐号管理
//******************************************************************************
    function user_model(funid:integer;msg:string):boolean;
    function checkpassword(s1,s2:string):boolean;
    procedure getuserlist(box1:tstrings);
    function getuserinfo(s:string):string;
//******************************************************************************
//部门管理
//******************************************************************************
    function dept_model(funid:integer;msg:string):boolean;
    procedure getdeptlist(box1:tstrings);
    procedure getworktypelist(box1:tstrings;s:String);
//******************************************************************************
//离职管理
//******************************************************************************
    function Parchives_model(funid:integer;msg:string):boolean;
//******************************************************************************
//宿舍管理
//******************************************************************************
    function dormitory_model(funid:integer;msg:string):boolean;
    procedure getbromlist(box1:tstrings);
//******************************************************************************
//  事件提示
//******************************************************************************
    function event_model(funid:integer;msg:string):boolean;
//******************************************************************************
//  税率表
//******************************************************************************
    function cess_model(funid:integer;msg:string):boolean;
//******************************************************************************
//  医疗保险
//******************************************************************************
    function medicare_model(funid:integer;msg:string):boolean;
//******************************************************************************
//  养老保险
//******************************************************************************
    function insurance_model(funid:integer;msg:string):boolean;
//******************************************************************************
//  个人所得税
//******************************************************************************
    function incometax_model(funid:integer;msg:string):boolean;

    
    { Public declarations }
  end;

var
  sl_data: Tsl_data;

implementation
uses inifiles,seldate,setprint,shareunit;
{$R *.DFM}


function Tsl_data.RegisterOleFile (strOleFileName : STRING; OleAction : Byte ) : BOOLEAN;
const
    RegisterOle = 1;//注册
    UnRegisterOle = 0;//卸载
type
    TOleRegisterFunction = function : HResult;//注册或卸载函数的原型
var
    hLibraryHandle : THandle;//由LoadLibrary返回的DLL或OCX句柄
    hFunctionAddress: TFarProc;//DLL或OCX中的函数句柄，由GetProcAddress返回
    RegFunction : TOleRegisterFunction;//注册或卸载函数指针
begin
Result := FALSE;
//打开OLE/DCOM文件，返回的DLL或OCX句柄
hLibraryHandle := LoadLibrary(PCHAR(strOleFileName));
if (hLibraryHandle > 0) then//DLL或OCX句柄正确
   try
      //返回注册或卸载函数的指针
      if (OleAction = RegisterOle) then
          hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllRegisterServer')) //返回注册函数的指针
      else  hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllUnregisterServer')); //返回卸载函数的指针
      if (hFunctionAddress <> NIL) then//注册或卸载函数存在
          begin
          RegFunction := TOleRegisterFunction(hFunctionAddress);//获取操作函数的指针
          if RegFunction >= 0 then //执行注册或卸载操作，返回值>=0表示执行成功
              result := true;
          end;
   finally
      FreeLibrary(hLibraryHandle);//关闭已打开的OLE/DCOM文件
   end;
end;

procedure Tsl_data.writeini;
var filename:string;
    inifile:tinifile;
begin
filename:=application.ExeName;
filename:=changefileext(filename,'.ini');
inifile:=tinifile.create(filename);
try                                        
inifile.Writeinteger('mainform','skincolor',nx);
inifile.writestring('mainform','remotecomputer',remotecomputer);
inifile.writestring('mainform','lastusername',lastusername);
finally
inifile.free;
end;
end;

procedure Tsl_data.readini;
var filename:string;
    inifile:tinifile;
begin
filename:=application.ExeName;
filename:=changefileext(filename,'.ini');
if fileexists(filename) then
  begin
  inifile:=tinifile.create(filename);        
    try
    nx:=inifile.readinteger('mainform','skincolor',0);
    remotecomputer:=inifile.readstring('mainform','remotecomputer','127.0.0.1');
    lastusername:=inifile.readstring('mainform','lastusername','system');
    finally
    inifile.free;
    end;
  end;
end;

{--------------------------打印部分--------------------------------}

procedure Tsl_data.setprint(temprint:tquickrep;bearing:boolean);
var
  I : TQRPaperSize;
begin
with Tsetprints.create(self) do
  try
  localstr:=temprint.ReportTitle;
  showmodal;
  finally
  for I:= Default to Custom do
  if QRPaperName(I) = PaperSize.Text then
     begin
     temprint.page.PaperSize := I;
     break;
     end else temprint.page.PaperSize:=Default;
  if PaperSize.Text='Custom Size' then
     try
     temprint.Page.Width:=strtofloat(edit5.text);
     temprint.page.Length:=strtofloat(edit6.text);
     except
     temprint.Page.Width:=210;
     temprint.page.Length:=290;
     end;

  if combobox2.ItemIndex=0 then
    temprint.Page.Orientation:=poPortrait else
    temprint.page.orientation:=poLandscape;

  temprint.Page.LeftMargin:=strtofloat(edit3.text);
  temprint.page.TopMargin:=strtofloat(edit1.text);
  temprint.page.RightMargin:=strtofloat(edit4.text);
  temprint.page.BottomMargin:=strtofloat(edit2.text);
  free;
  end;
temprint.Prepare;
pagecounts:=inttostr(temprint.qrprinter.pagecount);
temprint.Previewmodal;
end;

procedure Tsl_data.formonpaint(sender:tform);
var rect:trect;
begin
rect.Left:=0; rect.top:=0;
rect.Right:=sender.Width;
rect.Bottom:=sender.Height;
sender.canvas.StretchDraw(rect,pubbitmap);
end;

procedure Tsl_data.mainimage(bitmap1,bitmap2:tbitmap);
begin
ImageList1.GetBitmap(nx,bitmap1);
ImageList2.GetBitmap(nx,bitmap2);
end;

procedure Tsl_data.DataModuleCreate(Sender: TObject);
var paths:string;
begin
paths:=extractfilepath(application.exename);
RegisterOleFile(paths+'midas.dll',1);
readini;
pubbitmap:=tbitmap.Create;
imagelist2.GetBitmap(nx,pubbitmap);
end;

procedure Tsl_data.DataModuleDestroy(Sender: TObject);
begin
writeini;
freeandnil(pubbitmap);
end;

procedure Tsl_data.changecolors;
begin
if nx=2 then nx:=0 else nx:=nx+1;
imagelist2.GetBitmap(nx,pubbitmap);
end;

function  Tsl_data.selectdate:tdatetime;
begin
with tsel_date.create(nil) do
  try
  showmodal;
  finally
  result:=MonthCalendar1.Date;
  free;
  end;
end;

function Tsl_data.getserverdates:tdatetime;
begin
result:=sldcom.appserver.getserverdate;
end;

function Tsl_data.checkresult:boolean;
begin
result:=sldcom.AppServer.getoperation;
end;

//******************************************************************************
// HTML转换和DBGrid 控制
//******************************************************************************
procedure Tsl_data.autosizedbgrid(dbgrids:tdbgrid);
var i,n,w:integer;
begin
if dbgrids.DataSource<>nil then
   begin
    sl_data.querys.First;
    for i:=1 to dbgrids.Columns.Count do
      with dbgrids.columns.items[i-1] do
         width:=length(fieldname)*9;


    dbgrids.Perform(WM_SetRedraw, 0, 0);
    if sl_data.querys.RecordCount>0 then
     for i:=1 to sl_data.querys.recordcount do
       begin
       for n:=1 to sl_data.querys.FieldCount do
          begin
          w:=length(sl_data.querys.Fields[n-1].asstring)*9;
          if dbgrids.Columns.Items[n-1].Width<w then
             dbgrids.Columns.Items[n-1].Width:=w;
          end;
       sl_data.querys.next;