📄 commfun.pas.svn-base

📁 这是一个功能齐全的,代码完整的ERP企业信息管理系统,现在上传和大家分享
💻 SVN-BASE
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
    ReplaceString(APost,'',S);
    ReplaceString(ALink,'',S);
    ReplaceString(AYear4,'',S);
    ReplaceString(AYear2,'',S);
    ReplaceString(AMonth,'',S);
    ReplaceString(ADay,'',S);
    ANo:=StrToInt(S)+1;
  end;
  ANUM:=AddSpaces(IntToStr(ANo),Length(ANUM),'0',True);
  ReplaceString('%',ANUM,ARule);
  Result:=ARule;
end;

//取得权限
function GetRights(AProgram,AModule:String):string;
var
  S:String[7];
  AProgramNo:Integer;
  AQuery:TADOQuery;
begin
  if ASuper then S:='YYYYYYY' else S:='NNNNNNN';
  Result:=S;
  if ASuper then Exit;

  AQuery:=TADOQuery.Create(nil);
  AQuery.Connection:=SYSDM.ADOC;

  AQuery.Close;
  AQuery.SQL.Clear;
  AQuery.SQL.Add('select S500D_011 from SYS500D where S500D_001='+''''+AProgram+''''+' and S500D_002 like '+''''+AModule+GetLikeMark+'''');
  AQuery.Open;
  AProgramNo:=AQuery.Fields[0].AsInteger;
  AQuery.Close;
  AQuery.SQL.Clear;
  AQuery.SQL.Add('select S500B_004,S500B_005,S500B_006,S500B_007,S500B_008,S500B_009,S500B_010');
  AQuery.SQL.Add('from SYS500B where S500B_001='+IntToStr(AUserID)+' and S500B_002='+IntToStr(AProgramNo));
  AQuery.Open;
  if not AQuery.IsEmpty then
  begin
    if AQuery.Fields[0].AsBoolean then S[1]:='Y' else S[1]:='N';
    if AQuery.Fields[1].AsBoolean then S[2]:='Y' else S[2]:='N';
    if AQuery.Fields[2].AsBoolean then S[3]:='Y' else S[3]:='N';
    if AQuery.Fields[3].AsBoolean then S[4]:='Y' else S[4]:='N';
    if AQuery.Fields[4].AsBoolean then S[5]:='Y' else S[5]:='N';
    if AQuery.Fields[5].AsBoolean then S[6]:='Y' else S[6]:='N';
    if AQuery.Fields[6].AsBoolean then S[7]:='Y' else S[7]:='N';
    S:=S[1]+S[2]+S[3]+S[4]+S[5]+S[6]+S[7];
  end;
  Result:=S;
  AQuery.Close;
  AQuery.Free;
end;

//记录在线情况表
procedure SetLogIn(AProgram:string);
var
  AProgramNo:Integer;
  ADate:TDateTime;
  Year,Month,Day,Hour,Min,Sec,MSec:Word;
begin
  if AProgram='' then Exit;
  SYSDM.qryQuery.Close;
  SYSDM.qryQuery.SQL.Clear;
  SYSDM.qryQuery.SQL.Add('select top 1 S500D_011 from SYS500D where S500D_001='+''''+AProgram+'''');
  SYSDM.qryQuery.Open;
  if SYSDM.qryQuery.IsEmpty then Exit;
  AProgramNo:=SYSDM.qryQuery.Fields[0].AsInteger;
  ADate:=GetServerDate;
  SYSDM.qrySys300.Close;
  SYSDM.qrySys300.SQL.Clear;
  SYSDM.qrySys300.SQL.Add('select top 1 * from SYS300 where S300_001='+IntToStr(AUserID)+' and S300_002='+IntToStr(AProgramNo)+' order by S300_004 desc');
  SYSDM.qrySys300.Open;
  if SYSDM.qrySys300.FieldByName('S300_004').AsString=DateTimeToStr(ADate) then
  begin
    DecodeDateTime(ADate,Year,Month,Day,Hour,Min,Sec,MSec);
    Sec:=Sec+1;
    ADate:=EncodeDateTime(Year,Month,Day,Hour,Min,Sec,MSec);
  end;
  SYSDM.qrySys300.Append;
  SYSDM.qrySys300.FieldByName('S300_001').Value:=AUserID;
  SYSDM.qrySys300.FieldByName('S300_002').Value:=AProgramNo;
  SYSDM.qrySys300.FieldByName('S300_004').Value:=ADate;
  SYSDM.qrySys300.FieldByName('S300_005').Value:=GetDBString('COM00005018');
  try
    SYSDM.qrySys300.Post;
  except
    ShowMsg(SYSDM.qrySys300.Connection.Errors[0].Description,1);
    Exit;
  end;
end;

//记录在线情况表
procedure SetLogOut(AProgram:string);
var
  AProgramNo:Integer;
  ADate:TDateTime;
  Year,Month,Day,Hour,Min,Sec,MSec:Word;
begin
  if AProgram='' then Exit;
  SYSDM.qryQuery.Close;
  SYSDM.qryQuery.SQL.Clear;
  SYSDM.qryQuery.SQL.Add('select top 1 S500D_011 from SYS500D where S500D_001='+''''+AProgram+'''');
  SYSDM.qryQuery.Open;
  if SYSDM.qryQuery.IsEmpty then Exit;
  AProgramNo:=SYSDM.qryQuery.Fields[0].AsInteger;
  ADate:=GetServerDate;
  SYSDM.qrySys300.Close;
  SYSDM.qrySys300.SQL.Clear;
  SYSDM.qrySys300.SQL.Add('select top 1 * from SYS300 where S300_001='+IntToStr(AUserID)+' and S300_002='+IntToStr(AProgramNo)+' order by S300_004 desc');
  SYSDM.qrySys300.Open;
  if SYSDM.qrySys300.FieldByName('S300_004').AsString=DateTimeToStr(ADate) then
  begin
    DecodeDateTime(ADate,Year,Month,Day,Hour,Min,Sec,MSec);
    Sec:=Sec+1;
    ADate:=EncodeDateTime(Year,Month,Day,Hour,Min,Sec,MSec);
  end;
  SYSDM.qrySys300.Append;
  SYSDM.qrySys300.FieldByName('S300_001').Value:=AUserID;
  SYSDM.qrySys300.FieldByName('S300_002').Value:=AProgramNo;
  SYSDM.qrySys300.FieldByName('S300_004').Value:=ADate;
  SYSDM.qrySys300.FieldByName('S300_005').Value:=GetDBString('COM00005019');
  try
    SYSDM.qrySys300.Post;
  except
    ShowMsg(SYSDM.qrySys300.Connection.Errors[0].Description,1);
    Exit;
  end;
end;

//创建Access数据库
procedure CreateAccessDB(AFileName,APass:string);
var
  CreateAccess:OleVariant;
begin
  //当文件存在时，将原文件更名
  if FileExists(AFileName) then
  begin
    if ShowDialog('UMS10000128',0,MB_DEFBUTTON1)=IDNO then  //数据库已经存在，是否覆盖现有的数据库？
    begin;
      ShowMsg(GetDBString('UMS10000024'),1);  //创建数据库失败
      Abort;
    end;
    DeleteFile(AFileName);
  end;
  CreateAccess:=CreateOleObject('ADOX.Catalog');
  CreateAccess.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+AFileName+';Jet OLEDB:Database Password='+APass);
end;

//创建SQL Server数据库
procedure CreateSQLDB(APath,ADBName,AUser,APass,AServer:string);
var
  AADOC:TADOConnection;
  AQuery:TADOQuery;
begin
  AADOC:=TADOConnection.Create(nil);
  AADOC.LoginPrompt:=False;
  //连接数据库
  ConnectDB(AADOC,1,AServer,'master',AUser,APass);

  AQuery:=TADOQuery.Create(nil);
  AQuery.Connection:=AADOC;

{  if trim(APath)='' then
  begin
    AQuery.Close;
    AQuery.SQL.Clear;
    AQuery.SQL.Add('select filename from sysdatabases where name=''master''');
    AQuery.Open;
    APath:=AQuery.Fields[0].AsString;
    APath:=ExtractFilePath(APath);
    if APath[Length(APath)]<>'\' then APath:=APath+'\';
  end;  }

  AQuery.Close;
  AQuery.SQL.Clear;
  AQuery.SQL.Add('select 1 from sysdatabases where name='+''''+ADBName+'''');
  AQuery.Open;
  if not AQuery.IsEmpty then
  begin
    if ShowDialog('UMS10000128',0,MB_DEFBUTTON1)=IDNO then  //数据库已经存在，是否覆盖现有的数据库？
    begin;
      ShowMsg(GetDBString('UMS10000024'),1);  //创建数据库失败
      Abort;
    end;
    AQuery.Close;
    AQuery.SQL.Clear;
    AQuery.SQL.Add('drop database '+ADBName);
    AQuery.ExecSQL;
  end;
  AQuery.Close;
  AQuery.SQL.Clear;
  AQuery.SQL.Add('create database '+ADBName);
  if trim(APath)<>'' then
  begin
    AQuery.SQL.Add('on (name='+ADBName+'_DATA,filename='+''''+APath+ADBName+'.mdf'+''''+')');
    AQuery.SQL.Add('log on (name='+ADBName+'_LOG,filename='+''''+APath+ADBName+'.ldf'+''''+')');
  end;
  try
    AQuery.ExecSQL;
  except
    ShowMsg(AQuery.Connection.Errors[0].Description+#13+AQuery.SQL.Text,1);
    Abort;
  end;
end;

function GetGUID:string;
var
 id:tguid;
begin
 if CoCreateGuid(id)=s_ok then
  result:=guidtostring(id);
end;

//Stype=0  加密   Stype=1  解密
function EncDecStr(const S:String; Stype:Dword):string;
var
  I:Integer;
  FKey:Integer;
begin
  Result:='';
  if S='' then Exit;
  case Stype of
  0:
    begin
      Randomize;
      FKey:=19740507;
      for I:=1 to Length(S) do
        Result:=Result+Chr( Ord(S[I]) xor I xor FKey);
      Result:=Result + Char(FKey);
    end;
  1:
    begin
      FKey:=Ord(S[Length(S)]);
      for I:=1 to Length(S)-1 do
        Result:=Result+chr(Ord(S[I]) xor I xor FKey);
    end;
  end;
end;

//压缩Access数据库(带密码)
function CompactDatabase(AFileName,APassWord:string):boolean;
const
  SConnectionString='Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
      +'Jet OLEDB:Database Password=%s;';
var
  STempFileName:String;
  JE:OleVariant;
begin
  STempFileName:=ExtractFilePath(AFileName)+'~_Temp.mdb';
  try
    JE:=CreateOleObject('JRO.JetEngine');//建立OLE对象,函数结束OLE对象超过作用域自动释放
    OleCheck(JE.CompactDatabase(Format(SConnectionString,[AFileName,APassWord]),
        Format(SConnectionString,[STempFileName,APassWord])));//压缩数据库
    //复制并覆盖源数据库文件,如果复制失败则函数返回假,压缩成功但没有到函数的功能
    Result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
    DeleteFile(PChar(STempFileName));//删除临时文件
  except
    Result:=False;//压缩失败
  end;
end;

function DaoActive(var DaoObject:OleVariant):Boolean;
begin
  Result:=False;
  try
    DaoObject:=GetActiveOleObject('DAO.DBEngine.36');
    Result:=True;
  except
    try
      DaoObject:=CreateOleObject('DAO.DBEngine.36');
      Result:=True;
    except
      DaoObject:=Null;
    end;
  end;
end;

//压缩Access数据库
function DaoCompactDB(const FileName:string):Boolean;
var
  db:OleVariant;
  TempFile:string;
begin
  Result:=False;
  try
    if not DaoActive(db) then
      Exit;
    try
      TempFile:=ExtractFilePath(FileName)+'~_Temp.mdb';
      db.CompactDatabase(FileName,TempFile);
      DeleteFile(PChar(FileName));
      RenameFile(TempFile,FileName);
      Result:=True;
    except
      on E:EOleException do
        ShowMessage(E.Message);
    end
  finally
    db:=Unassigned;
  end;
end;

//模块安装否
function GetSetup(AModule:string):boolean;
begin
  SYSDM.qrySys800.Close;
  SYSDM.qrySys800.SQL.Clear;
  SYSDM.qrySys800.SQL.Add('select 1 from HwSystem where FInstall=-1 and FCode='+''''+AModule+'''');
  SYSDM.qrySys800.Open;
  Result:=not SYSDM.qrySys800.IsEmpty;
end;

function IsExists(ASQL:string):Boolean;
begin
  Result:=False;
  SYSDM.qryQuery.Close;
  SYSDM.qryQuery.SQL.Clear;
  SYSDM.qryQuery.SQL.Add(ASQL);
  try
    SYSDM.qryQuery.Open;
    Result:=not SYSDM.qryQuery.IsEmpty;
  except
    ShowMsg(GetDBString('UMS10000129')+#13+SYSDM.qryQuery.SQL.Text,1);  //下列SQL语句错误，请检查
    Abort;
  end;
end;

function GetValue(ASQL:string):Variant;
var
  S:String;
begin
  if IsExists(ASQL) then
    if SYSDM.qryQuery.Fields[0].IsNull then Result:=S else Result:=SYSDM.qryQuery.Fields[0].Value
  else
    Result:='';
end;

function ExecSQL(ASQL:string):Boolean;
begin
  Result:=False;
  SYSDM.qryQuery.Close;
  SYSDM.qryQuery.SQL.Clear;
  SYSDM.qryQuery.SQL.Add(ASQL);
  try
    SYSDM.qryQuery.ExecSQL;
    Result:=True;
  except
    ShowMsg(GetDBString('UMS10000129')+#13+SYSDM.qryQuery.SQL.Text,1);  //下列SQL语句错误，请检查
    Abort;
  end;
end;

function HtmlHelp(hwndCaller:HWND;strFile:String;uCommand:UINT; dwData:DWORD_PTR ):HWND;
var
 LFileName:String;
 p:PChar;
begin
 if HHControlInstance=0 then
 begin
   LFileName := StringOfChar( ' ', 256);
   p := PChar( LFilename );
   GetSystemDirectory(p,255);
   StrCat(p,'\hhctrl.ocx');
   HHControlInstance := LoadLibrary( P );
   if HHControlInstance = 0 then
     raise exception.Create('Help system not installed!'#13' HTMLHELP cannot displayed!');
   @HtmlHelpA := GetProcAddress( HHControlInstance, 'HtmlHelpA');
   if @HtmlHelpA = nil then
     raise exception.Create('Function HTMLHELP cannot loaded!');
   HtmlHelpA( 0, nil,$001C , (@dwCookie));
 end;
 result := HtmlHelpA( hwndCaller, PChar( strFile ), uCommand, dwData );
end;

procedure CloseHtmlHelp;
begin
 if HHControlInstance<>0 then
 begin
   HtmlHelpA( 0, nil, $001D, DWORD_PTR(dwCookie));
   FreeLibrary(HHControlInstance);
 end;
end;

//检查试用版是否过期  Ture:未过期,False:已过期
function IsTry(AProdID,AProdVer,ARunTimes:String):Boolean;
var
  S:String;
begin
  Result:=False;
  S:=EncDecStr(ARunTimes,1);
  try
    StrToInt(S);
    if StrToInt(S)<45 then Result:=True;
  except
    Result:=False;
  end;
end;

function ReadReg(Key:s
上一页 1 2 3 45
💿 文件大小 5005 K
👤 上传用户 struggle10000
📂 所属分类企业管理
🏷️ 相关标签

#ERP #代码 #企业信息 #管理系统
⌨️ 快捷键说明

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