📄 invdm.~pas
字号:
unit InvDM;
interface
uses
SysUtils, Classes, DB, DBTables, IniFiles, Windows, StdCtrls, QControls,
Dialogs, ComCtrls, InvDef, dpConst, Math;
type
Tdm_Inventory = class(TDataModule)
Query: TQuery;
StoredProc: TStoredProc;
Database: TDatabase;
qryAutoPaperNo: TQuery;
StpInOutStk: TStoredProc;
qrypm_mrp: TQuery;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
{ Private declarations }
procedure LoadDBInfo(var Alias, UserName, Password: string);
function DatabaseOpen(Alias, UserName, PassWord: string): Boolean;
procedure DatabaseClose;
/////////////////////////////
Function CreateQuery(qryName: string; dbName: string): TQuery;
Function CreateStroreProc(StorProc: string; dbName: string): TStoredProc;
function ExecuteQuery(Sqls: string): Boolean;
function GetRecid1: LongInt;
function GetRecid7: LongInt;
public
{ Public declarations }
DBConnected: Boolean;
procedure ListFreeMemory(List:TList);
function UpdateDatabase(TableName: string; var Recid: LongInt; UpdateList: TList): Integer;
function DeleteDatabase(TableName: string; RecId: Longint): Integer;
function DateProc(edt: TEdit; var ADate: TDateTime): Boolean;
function DateErrorCheck(DateText: string; var ADate: TDateTime): Boolean;
function REC_IDProc(IX: Integer; edt: TEdit; var ARID: LongInt; ARID2: LongInt): Boolean;
function MasterProc(CD: Integer; var edt: TEdit): Boolean;
function GetShigenName(Sigen_CD: Integer): String;
function GetDepartName(sigen_CD: Integer): string;
function GetOrderNo(RID: LongInt): string;
function GetOrderRID(CD: string): LongInt;
function GetOrderID(OrderCode: string): Integer;
function GetPartID(OrderID: Integer; PartCode: string): Integer;
function GetOrderPartIDFromOrderNo(OrderNo: Integer; var OrderID, PartID, ProcessID: Integer): Integer;
function GetPartCode(OrderID, PartID: Integer): string;
function GetMaterialRID(CD: string): LongInt;
function GetMaterialCode(RID: LongInt): string;
function GetMaterialName(RID: LongInt): string;
function GetMaterialStandardName(RID: LongInt): string;
function GetUnitType(RID: LongInt): integer;
function GetUnitTypeName(RID: LongInt): string;
Function GetStdUnitPrice(RID: LongInt): Double;
Function GetHatNoUnitPrice(hat_no: LongInt): Double;
Function GetUPNameFromID(iMode: Integer): String;
Function GetSafeStockQty(RID: LongInt): Double;
Function Get_MatGuageSafety(mat_rec_id,guage_id: LongInt): double;
function GetStockName(stkid: string): string;
function Get_StockCheck(stkid: string; var edt: TEdit): Boolean;
procedure Read_GuageInfoToCbx(edt: TEdit; cbx: TComboBox);
procedure Read_GuageInfoToCbx2(edt: TEdit; cbx: TComboBox);
procedure Read_MatGuageInfo(sList: TList);
Function Get_GuageName(mat_recid,guage_id: integer): string;
function Get_GuageCheck(mat_recid,guage_id: integer; var edt: TEdit): Boolean;
procedure Read_IOIDInfo_ToCbx(cbx: TComBoBox; sIndex: integer);
function Read_IOIDInfo(sIndex: integer; sList: TList): Integer;
function InOut_IDProc(scode: string; IType: integer; var edt: TEdit): Boolean;
function Get_IOIDName(sCode: string; itype: integer): string;
Procedure Read_SupplyMake_ToCbx(cbx: TComBoBox);
procedure Read_EmpInfoToCbx(cbx: TComBoBox);
Procedure Read_EmpInfo;
function Get_EmpName(shigen_CD: string): string;
function Get_EmpDepartID(shigen_CD: string): Integer;
function GetDepartName_fromEmpID(Sigen_CD: string): String;
function Emp_IDProc(scode: string; var edt: TEdit): Boolean;
function InsertShizai(lcP: PSHIZAI): Integer;
function InsertInventory(lcP: PINVENTORY): Integer;
function UpdateProcess_jkcd(InvValue: TINVENTORY_VALUE): Integer;
function UpdateProcess_flag2(InvValue: TINVENTORY_VALUE): Integer;
function UpdateProcessLog_jkcd_kakojokyo(ihatchu_id: Integer): Integer;
function UpdateProcess(InvValue: TINVENTORY_VALUE): Integer;
function UpdateLog_jkcd(InvValue: TINVENTORY_VALUE): Integer;
function UpdateLog(InvValue: TINVENTORY_VALUE): Integer;
function UpdateHatNo_JKCD(var order_no: Integer): Integer;
function InsertProcess(InvValue: TINVENTORY_VALUE; var RecId: Integer): Integer;
function InsertLog(InvValue: TINVENTORY_VALUE): Integer;
procedure GetInvData(var InvValue: TINVENTORY_VALUE; UpdateList: TList; var Error: Integer);
function DeleteProcess(InvRecId: Integer): Integer;
function DeleteLog(InvRecId: Integer): Integer;
function Insert_DeleteInventory(Inv_s: PINVENTORY; del_empid: Double): Integer;
function is_NeedUpdateOrdered(var InvValue: TINVENTORY_VALUE; rec_id: Integer): Boolean;
function get_orderedQty_fromOrderNo(var iOrder_no: Integer; var order_qty,order_weight: Double): Double;
function get_stkDeliveriedQty_fromOrderNo(var iOrder_no: Integer): Double;
procedure ReadShigen;
procedure Readresource(sList: TList; igroup: Integer; scode,sname: string);
procedure ReadDepartment;
procedure ReadSeihin;
procedure Delete_RepeatMaterialcode;
Procedure ReadShizai(List: TList);
Procedure ReadShiZai_Kubun;
Procedure Read_shizai_kubunTocbx(cbx: TComBoBox);
function Get_Shizai_KubunAttr(kubun_code: string): integer;
function Get_Shizai_KubunName(RecID: integer): string;
function Get_Shizai_KubunName2(sCode: string): string;
Function GetMaterialTypeID(recid: integer): LongInt;
function GetMaterialHiyoKubunID(RID: LongInt): Integer;
function GetShiZaiKubunID(sCode: string): integer;
function Get_Shizai_KubunCode(RecID: integer): string;
function Get_KubunRecID_FromShiZai(RecID: integer): integer;
function Get_KubunIssMode_FromShiZai(Mat_RecID: integer): integer;
//////////////////////////////////////////////
function Get_AutoPaperNo(sPaperID: string): string;
function Get_PaperNO(suplier: integer; sdate: TDatetime; imax: integer; iMode: integer): string;
function ReadInventory(InitFlg: Boolean; List: TList): Integer;
function ReadInventory2(InitFlg: Boolean; List: TList; FDate,EDate: TDateTime): Integer;
function ReadInventory3(List: TList; mat_rec_id: LongInt; stk_id: string): Integer;
function ReadInventory4(List: TList; mat_rec_id,guage_id: LongInt; stk_id: string): Integer;
function ReadInventory5(List: TList; order_rec_id: Integer; iKind: Byte): Integer;
function Read_IOHistoryQuery(sList: TList; FDate,EDate: TDatetime;
stkid: string; sup_cd: Integer; iss_paperno: string; mat_rec_id: Integer;
order_rec_id: integer; paperno: string;
order_code: string; iKind: integer): Integer;
Procedure Read_IOHistory(sList: TList; stkid: string; iKind: integer; FDate,EDate: TDateTime);
function Read_InventoryRpt(InitFlg: Boolean; List: TList; iKind: integer; sFDate,sEDate: TDatetime): Integer;
function Read_InventoryHisRpt(InitFlg: Boolean; List: TList; iKind: integer): Integer;
Procedure Delete_NullMaterial;
function Update_InventorySheetActSts(InvRecId,iAll_Sts: Integer): Integer;
Function Read_InOutStkList(ftime,etime: string): integer;
Function Read_InOutStkList_Cost(ftime,etime: string): integer;
Function isExists_IOID(lcp: PClassInfo): Boolean;
Procedure Delete_Repeat_IOIDInfo;
Procedure Insert_IOIDInfo(lcp: PClassInfo);
Procedure Update_IOIDInfo(lcp: PClassInfo);
Procedure Delete_IOIDInfo(lcp: PClassInfo);
//////////////////////////////////////////////
function Read_PaperParams(sList: TList): Integer;
function isExists_paperno(sinput: string; ikind: Integer): Boolean;
Function Read_UnDeliveryOnTimeInfo(sList: TList; sfdate,sedate: string): integer;
Function Read_DeliveryOnTimeInfo(sList: TList; s1,s2,s3,s4: string; L1,L2: integer): integer;
Function GetInfoFromInvOrderNo(OrderNo: Integer; var inOrderInfo: TAllReadyInValue): integer;
//////////////////////////////////////////////
Function isExists_UseGuageID(mat_rec_id,guage_id: integer): Boolean;
Function isExists_GuageInfo(mat_rec_id: integer; sGuage: String): Boolean;
Function isExists_invGuageID(mat_rec_id: integer; iGuageID: integer): Boolean;
Function Get_MatMaxGuageID(mat_rec_id: integer): Integer;
Function Get_GuageID(mat_rec_id: Integer; sGuage: string): Integer;
Function Get_MatGuageWgtPcs(mat_rec_id,guage_id: integer): Double;
Procedure Insert_MatGuageInfo(mat_rec_id: integer; sGuage: string);
Procedure Insert_NewGuage_ID(mat_rec_id: integer; iguage_id: integer; sGuage: string);
Procedure Update_MatGuageInfo(mat_rec_id,guage_id: integer; sGuage: string);
Procedure Update_MatSafety(mat_rec_id,guage_id: integer; isafety,imax,ifixed,ilead:integer;wghtpcs:double);
Procedure Update_MatWeightPCS(mat_rec_id,guage_id: integer; wghtpcs:double);
Procedure Delete_MatGuageInfo(mat_rec_id,guage_id: integer);
Function Bala_TotalWeightCheck(balaqty,useqty: double; hatchu_id: LongInt): Boolean;
Function LastYearFromDay: TDatetime;
Function LastYearEndDay: TDatetime;
Procedure DataExpImp(iMode: Integer; FDate,EDate: TDatetime);
///////////////////////////////////////////////////////////////////////
Function Read_BomCheckInfo(sList: TList): integer;
Function Read_CurrInventoryInfo(sList: TList): integer;
Function Read_MRPInfo(sList: TList; ifix,ibom: integer): integer;
///////////////////////////////////////////////////////////////////////
function Read_MoldInvInfo(sList: TList; iMode: Integer): Integer;
function Read_InvAgeInfo(sList: TList; iMode: Integer): Integer;
function Get_HatCodeStr(i: Integer): string;
///////////////////////////////////////////////////////////////////////
function is_DateInAccountedMonth(stk_id: string; sInputDate: TDatetime): Boolean;
function Get_DefaultYearandMonth(iPageIndex: Integer; stk_id: string; var sYear,sMonth: string): integer;
function Read_AccountInfo(sList: TList): Integer;
function Run_CloseAccountJob(ikind: integer; stk_id,sYear,sMonth: string; empid: Double): Integer;
function Run_CancelAccountJob(ikind: integer; stk_id,sYear,sMonth: string; empid: Double): Integer;
//////////////////////////////////////////////
Function Read_UserPrivilegeList(sList: TList): integer;
function isExists_UserID(lcp: PUserPrivilege): Boolean;
procedure Insert_UserPrivilege(lcp: PUserPrivilege);
procedure Update_UserPrivilege(lcp: PUserPrivilege);
procedure Delete_UserPrivilege(lcp: PUserPrivilege);
function isExists_UserOrPassword(userid,password: string): Boolean;
Function Read_UserFunction(var FUser: TUserPrivilege; userid,password: string): integer;
end;
var
dm_Inventory: Tdm_Inventory;
IniData: TIniFileData;
FAllIOList,
FEmpList,
FGuageList,
FShiZaiList,
ShiZai_KubunList,
FInOutIDList,
FInOutStkList,
FInOutStkCostList: TList; //-- in/out/stk cost List
ShigenTBL: TList; //-- resource list
FDepartShigen: TList; //-- department list
SeihinTBL: TList; //-- seihin list
BuhinTBL: TList; //-- buhin list
FUserPrivilegeList: TList; //-- User Priviliege list
ReRead_RID: array of LongInt; //-- REC_ID
ReRead_Cnt: Integer; //-- ReRead_RID --
Delete_RID: array of LongInt; //-- REC_ID
Delete_Cnt: Integer; // Delete_RID --
RecIdType: Byte;
cUType: array [0..20] of string;
implementation
{$R *.dfm}
//
function SearchFieldDefData(TableName: string; ColumnOffset: Integer): PTABLEDEF;
var
i: Integer;
begin
Result := nil;
for i := 0 to TableDefCount - 1 do begin
if (AnsiCompareStr(TableName, TableDefs[i].TableName) = 0) and
(ColumnOffset = TableDefs[i].ColumnOffset) then begin
Result := @Tabledefs[i];
Exit;
end;
end;
end;
function MakeUpdateValue(DataType: Integer; TARGET: Pointer): string;
var
Tmps: array[0..128] of Char;
begin
Result := '';
case DataType of
sqTINYINT_TYPE : Result := IntToStr( Byte(Target^) );
sqSMALLINT_TYPE : Result := IntToStr( SmallInt(Target^) );
sqINTEGER_TYPE : Result := IntToStr( Integer(Target^) );
sqDATETIME_TYPE : Result := QuotedStr(FormatDateTime('yyyy/mm/dd hh:mm',
TDateTime(Target^)));
sqTEXT_TYPE:
begin
StrPCopy(Tmps, PChar(Target));
Result := QuotedStr(StrPas(Tmps));
end;
sqFLOAT_TYPE: Result := Format('%8.4f',[Double(Target^)]);
end;
end;
function MakeInsertSqlSentence(TableName: string; var Recid: Longint;
UpdateList: TList; var Error: Integer): string;
var
i: Integer;
lcP: PTABLEDEF;
lcUdP: PUPDATE_LIST;
Sep, Sqls1, Sqls2, SRecId: string;
MaterialRecId, OrderRecId, PartRecId,is_account,is_close: Integer;
UnitPrice, TotalPrice, Quantity, maker_price: Double;
begin
Error := 0;
OrderRecId := 0;
PartRecId := 0;
if TableName = 'shizai' then begin
Sqls1 := 'flag,'; Sqls2 := '1,';
end else begin
Sqls1 := ''; Sqls2 := '';
end;
Sep := '';
Recid := dm_Inventory.GetRecid7;
for i := 0 to UpdateList.Count - 1 do begin
lcUdP := UpdateList[i];
lcP := SearchFieldDefData(TableName, lcUdP^.Index);
if lcP = nil then begin
Error := -1;
Exit;
end;
if lcP^.ColumnName = 'material_rec_id' then
MaterialRecId := Integer(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'unit_price' then
UnitPrice := Double(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'quantity' then
Quantity := Double(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'maker_price' then
maker_price := Double(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'total_price' then
TotalPrice := Double(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'guage_id' then
TotalPrice := Double(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'use_quantity' then
TotalPrice := Double(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'use_amount' then
TotalPrice := Double(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'order_rec_id' then
OrderRecId := Integer(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'parts_rec_id' then
PartRecId := Integer(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'is_account' then
is_account := Integer(lcUdP^.TARGET^)
else
if lcP^.ColumnName = 'is_close' then
is_close := Integer(lcUdP^.TARGET^);
Sqls1 := Sqls1 + Sep + lcP^.ColumnName;
Sqls2 := Sqls2 + Sep + MakeUpdateValue(lcP^.DataType, lcUdP^.TARGET);
Sep := ',';
end;
if RecIdType = 0 then SRecId := 'rec_id'
else SRecId := 'rec_id';
Result := 'INSERT INTO ' + TableName + ' (' + SRecId + ',' + Sqls1 + ') '+
'VALUES(' + IntToStr(Recid) + ',' + Sqls2 + ')';
end;
//***-- SQL--
function MakeUpdateSqlSentence(TableName: string; var Recid: Longint;
UpdateList: TList; var Error: Integer): string;
var
i: Integer;
lcUdP: PUPDATE_LIST;
lcP: PTABLEDEF;
Sep, Sqls, SRecId: string;
begin
Error := 0;
Sqls := ''; Sep := '';
for i := 0 to UpdateList.Count - 1 do begin
lcUdP := UpdateList[i];
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -