Hi,
I installed Gambas Beta from Launchpad and tested it with my projects.
By opening one of them gambas3 destroys a module.
I attach them, the original is MLagerverwaltung.module, the destroyed
one is MLagerverwaltung.module.destroyed.
Shall I write a bug?
Alles Gute
Christof Thalhofer
--
Dies ist keine Signatur
' Gambas module file
Export
'' Nimmt eine neue Charge auf und liefert
'' den Primarykey der Charge
Public Function ChargeInLagerAufnehmen(PkRohproduktBestand As Long, sCharge As
String, Lnr As Long, menge As Float) As Long
Dim qry, msg As String
Dim res As Result
Dim pkcharge As Long
'testen, ob das Rohprodukt bei diesem hersteller
'bereits eingerichtet ist
pkcharge = GetPkCharge(sCharge, Lnr, PkRohproduktBestand)
' If GefundeneAlteCharge <> Null And GefundeneAlteCharge <> Charge Then
If pkcharge > 0 Then
msg = "Diese Charge ist schon registriert, aber mit einer " &
"anders geschriebenen Chargennummer. Bitte diese verwenden." '&
gb.lf & GefundeneAlteCharge
Message.Warning(msg)
Goto raus_ChargeInLagerAufnehmen
End If
qry = "SELECT fkproduktroh_bestand from tblieprod where Lnr = " &
Lnr & " and fkproduktroh_bestand = " & PkRohproduktBestand & ";"
res = DBs.Deg.Exec(qry)
If res.Count = 0 Then
msg = "Bei dem gewählten Hersteller ist das Rohprodukt nicht
eingerichtet. " &
"Bitte erst in den Produkten des Herstellers anlegen."
Message.Warning(qry)
Goto raus_ChargeInLagerAufnehmen
End If
' ------------------------------------------------- Charge speichern
'nächste chargennummer
qry = "SELECT nextval('tbproduktcharge_pkproduktcharge_seq');"
res = DBs.Deg.Exec(qry)
pkcharge = res[0]
'neue charge erstellen
qry = "INSERT INTO tbproduktcharge (pkproduktcharge, " &
"bestand, Lnr, herstellercharge, fkproduktroh_bestand, " &
"herstellercharge_komp)VALUES " &
"(" & pkcharge & "," & menge & "," &
Lnr & ",'" & sCharge & "'," &
PkRohproduktBestand & ", '" & DegString.LowerCompact(sCharge) & "');"
DBs.Deg.Exec(qry)
raus_ChargeInLagerAufnehmen:
Return pkcharge
End
'' testet, ob die eingegebene Chargennummer schon einmal vorhanden ist
'' sorgt dafür mit einer Postgres-Regex für entfernung von space und
sonderzeichen
'' liefert den primarykey der charge oder 0 wenn nicht gefunden
Public Function GetPkCharge(Charge As String, Lnr As Long, PkProduktrohBestand
As Long) As Long
Dim origchargename As String
Dim qry As String
Dim res As Result
origchargename = DegString.LowerCompact(Charge)
qry = "select pkproduktcharge from tbproduktcharge " &
"where Lnr = " & Lnr & " and herstellercharge_komp = '" &
origchargename &
"' and fkproduktroh_bestand = " & PkProduktrohBestand & ";"
res = Dbs.Deg.Exec(qry)
If res.Count > 0 Then
Return res!pkproduktcharge
Else
Return 0
End If
End
'' testet, ob ein gegebener Mengenname (Stück, l, 10erPack...) für ein
'' Rohprodukt in der Lagerverwaltung richtig ist
Function TesteMengennameFuerRohprodukt(fkproduktroh_bestand As Long, mengenname
As String) As Boolean
Dim ergebnis As Boolean
Dim res As Result
Dim qry As String
Dim lagermengenname As String
Dim inttest As Integer
qry = "select mengenname from tbproduktroh_bestand where
pkproduktroh_bestand = " & fkproduktroh_bestand & ";"
res = DBs.Deg.Exec(qry)
lagermengenname = res!mengenname
'Schauen, ob der übergebene Mengenname zum Lagermengennamen passt
qry = "select count (*) as anzahl from tbmengenfaktor where vergleichname =
'" &
lagermengenname & "' AND mengenname = '" & mengenname & "';"
res = DBs.Deg.Exec(qry)
inttest = res!anzahl
If inttest > 0 Then
ergebnis = True
Else
ergebnis = False
End If
Return ergebnis
End
'' Übernimmt ein Rohprodukt eines Herstellers in das Lager.
'' Reduziert, falls vorhanden, Kontrakte.
''
'' Achtung diese Funktion übernimmt nur
'' Grundmengen, wie Stück, L, m, etc.
'' Faktoren, wie 6erPack etc müssen vorher umgerechnet worden sein
'' Liefert cancel = false bei erfolg
''
'' Charge kann Null oder "" sein
Public Function LagerAddiereLieferungProduktinLager(Lnr As Long,
PkLiebestellDetail As Long, PkRohproduktBestand As Long, Menge As Float,
Optional sCharge As String) As Boolean
Dim cancel As Boolean = True
Dim res As Result
Dim qry As String
Dim strmenge As String
Dim sql As New SqlWrapper(DBs.Deg)
Dim PkCharge As Long
strmenge = DegString.KommaZuPunkt(Menge)
'spiele die verschiedenen fälle durch
'1. es gibt keine Charge
'hier werden keine kontrakte upgedatet - kein kontrakt ohne charge!
If sCharge = Null Then
' ------------------------------------------------- Produkt ohne Charge
' ------------------------------------------------- Test ob Charge
notwendig
qry = "SELECT tbproduktroh_bestand.chargenverwaltung from
tbproduktroh_bestand " &
"where tbproduktroh_bestand.pkproduktroh_bestand = " &
PkRohproduktBestand & ";"
res = Dbs.Deg.Exec(qry)
If res[0] = -1 Then
Message.Error("Ein Fehler ist aufgetreten. Dieses Produkt benötigt
eine Chargennummer des Herstellers.")
cancel = True
Goto Ende
End If
' ------------------------------------------------- Produkt übernehmen
sql.Begin
'in tbliebestelldetail als ausgetragen markieren
qry = "UPDATE tbliebestelldetail SET inlageruebernommen = -1 WHERE
pkbestelldetail = " &
PkLiebestellDetail & ";"
Dbs.Deg.exec(qry)
'in das lager übernehmen
qry = "UPDATE tbproduktroh_bestand SET bestand = bestand + " &
strmenge & " WHERE pkproduktroh_bestand = " & PkRohproduktBestand &
";"
Dbs.Deg.exec(qry)
sql.Commit
cancel = False
Goto Ende
Else
' ------------------------------------------------- Produkt mit Charge
'2.fall, es gibt eine chargennummer des herstellers
'schauen, ob diese chargennummer bereits vorhanden ist
'zuerst die eindeutigkeit der chargennummer klarstellen
PkCharge = GetPkCharge(sCharge, Lnr, PkRohproduktBestand)
If PkCharge > 0 Then
'charge wurde gefunden
'die menge im lager wird erhöht
sql.Begin
'produktabruf beim kontrakt festhalten, wenn kontrakt existiert
cancel = MKontrakt.EingangAusKontraktenAusbuchen(Lnr,
PkRohproduktBestand, Menge, PkCharge)
If cancel = False Then
qry = "UPDATE tbproduktcharge SET bestand = bestand + " &
strmenge &
" WHERE pkproduktcharge = " & PkCharge & ";"
Dbs.Deg.exec(qry)
'in tbliebestelldetail als ausgetragen markieren
'FIXME: Darf nur dann den eingang beenden, wenn die menge
komplett übernommen wurde
qry = "UPDATE tbliebestelldetail SET inlageruebernommen = -1
WHERE pkbestelldetail = " & PkLiebestellDetail & ";"
Dbs.Deg.exec(qry)
sql.Commit
Else
sql.Rollback
End If
Goto Ende
Else
sCharge = DegString.LowerCompact(sCharge)
'diese charge des herstellers wurde nicht gefunden
'eine neue charge muß erstellt werden
sql.Begin
'in tbliebestelldetail als ausgetragen markieren
qry = "UPDATE tbliebestelldetail SET inlageruebernommen = -1 WHERE
pkbestelldetail = " & PkLiebestellDetail & ";"
Dbs.Deg.exec(qry)
PkCharge = ChargeInLagerAufnehmen(PkRohproduktBestand, sCharge,
Lnr, strmenge)
If PkCharge > 0 Then
'produktabruf beim kontrakt festhalten, wenn kontrakt für
dieses produkt existiert
cancel = MKontrakt.EingangAusKontraktenAusbuchen(Lnr,
PkLiebestellDetail, PkRohproduktBestand, Menge, PkCharge)
If cancel = False Then
sql.Commit
End If
Endif
If cancel = True Then
sql.Rollback
Endif
Goto Ende
End If
End If
Ende:
Return cancel
End
' Gambas module file
Export
'' Nimmt eine neue Charge auf und liefert
'' den Primarykey der Charge
Public Function ChargeInLagerAufnehmen(PkRohproduktBestand As Long, sCharge As
String, Lnr As Long, menge As Float) As Long
Dim qry, msg As String
Dim res As Result
Dim pkcharge As Long
'testen, ob das Rohprodukt bei diesem hersteller
'bereits eingerichtet ist
pkcharge = GetPkCharge(sCharge, Lnr, PkRohproduktBestand)
' If GefundeneAlteCharge <> Null And GefundeneAlteCharge <> Charge Then
If pkcharge > 0 Then
msg = "Diese Charge ist schon registriert, aber mit einer " &
"anders geschriebenen Chargennummer. Bitte diese verwenden." '&
gb.lf & GefundeneAlteCharge
Message.Warning(msg)
Goto raus_ChargeInLagerAufnehmen
End If
qry = "SELECT fkproduktroh_bestand from tblieprod where Lnr = " &
Lnr & " and fkproduktroh_bestand = " & PkRohproduktBestand & ";"
res = DBs.Deg.Exec(qry)
If res.Count = 0 Then
msg = "Bei dem gewählten Hersteller ist das Rohprodukt nicht
eingerichtet. " &
"Bitte erst in den Produkten des Herstellers anlegen."
Message.Warning(qry)
Goto raus_ChargeInLagerAufnehmen
End If
' ------------------------------------------------- Charge speichern
'nächste chargennummer
qry = "SELECT nextval('tbproduktcharge_pkproduktcharge_seq');"
res = DBs.Deg.Exec(qry)
pkcharge = res[0]
'neue charge erstellen
qry = "INSERT INTO tbproduktcharge (pkproduktcharge, " &
"bestand, Lnr, herstellercharge, fkproduktroh_bestand, " &
"herstellercharge_komp)VALUES " &
"(" & pkcharge & "," & menge & "," &
Lnr & ",'" & sCharge & "'," &
PkRohproduktBestand & ", '" & DegString.LowerCompact(sCharge) & "');"
DBs.Deg.Exec(qry)
raus_ChargeInLagerAufnehmen:
Return pkcharge
End
'' testet, ob die eingegebene Chargennummer schon einmal vorhanden ist
'' sorgt dafür mit einer Postgres-Regex für entfernung von space und
sonderzeichen
'' liefert den primarykey der charge oder 0 wenn nicht gefunden
Public Function GetPkCharge(Charge As String, Lnr As Long, PkProduktrohBestand
As Long) As Long
Dim origchargename As String
Dim qry As String
Dim res As Result
origchargename = DegString.LowerCompact(Charge)
qry = "select pkproduktcharge from tbproduktcharge " &
"where Lnr = " & Lnr & " and herstellercharge_komp = '" &
origchargename &
"' and fkproduktroh_bestand = " & PkProduktrohBestand & ";"
res = Dbs.Deg.Exec(qry)
If res.Count > 0 Then
Return res!pkproduktcharge
Else
Return 0
End If
End
'' testet, ob ein gegebener Mengenname (Stück, l, 10erPack...) für ein
'' Rohprodukt in der Lagerverwaltung richtig ist
Function TesteMengennameFuerRohprodukt(fkproduktroh_bestand As Long, mengenname
As String) As Boolean
Dim ergebnis As Boolean
Dim res As Result
Dim qry As String
Dim lagermengenname As String
Dim inttest As Integer
qry = "select mengenname from tbproduktroh_bestand where
pkproduktroh_bestand = " & fkproduktroh_bestand & ";"
res = DBs.Deg.Exec(qry)
lagermengenname = res!mengenname
'Schauen, ob der übergebene Mengenname zum Lagermengennamen passt
qry = "select count (*) as anzahl from tbmengenfaktor where vergleichname =
'" &
lagermengenname & "' AND mengenname = '" & mengenname & "';"
res = DBs.Deg.Exec(qry)
inttest = res!anzahl
If inttest > 0 Then
ergebnis = True
Else
ergebnis = False
End If
Return ergebnis
End
'' Übernimmt ein Rohprodukt eines Herstellers in das Lager.
'' Reduziert, falls vorhanden, Kontrakte.
''
'' Achtung diese Funktion übernimmt nur
'' Grundmengen, wie Stück, L, m, etc.
'' Faktoren, wie 6erPack etc müssen vorher umgerechnet worden sein
'' Liefert cancel = false bei erfolg
''
'' Charge kann Null oder "" sein
Public Function LagerAddiereLieferungProduktinLager(Lnr As Long,
PkLiebestellDetail As Long, PkRohproduktBestand As Long, Menge As Float,
Optional sCharge As String) As Boolean
Dim cancel As Boolean = True
Dim res As Result
Dim qry As String
Dim strmenge As String
Dim sql As New SqlWrapper(DBs.Deg)
Dim PkCharge As Long
strmenge = DegString.KommaZuPunkt(Menge)
'spiele die verschiedenen fälle durch
'1. es gibt keine Charge
'hier werden keine kontrakte upgedatet - kein kontrakt ohne charge!
If sCharge = Null Then
' ------------------------------------------------- Produkt ohne Charge
' ------------------------------------------------- Test ob Charge
notwendig
qry = "SELECT tbproduktroh_bestand.chargenverwaltung from
tbproduktroh_bestand " &
"where tbproduktroh_bestand.pkproduktroh_bestand = " &
PkRohproduktBestand & ";"
res = Dbs.Deg.Exec(qry)
If res[0] = -1 Then
Message.Error("Ein Fehler ist aufgetreten. Dieses Produkt benötigt
eine Chargennummer des Herstellers.")
cancel = True
Goto Ende
End If
' ------------------------------------------------- Produkt übernehmen
sql.Begin
'in tbliebestelldetail als ausgetragen markieren
qry = "UPDATE tbliebestelldetail SET inlageruebernommen = -1 WHERE
pkbestelldetail = " &
PkLiebestellDetail & ";"
Dbs.Deg.exec(qry)
'in das lager übernehmen
qry = "UPDATE tbproduktroh_bestand SET bestand = bestand + " &
strmenge & " WHERE pkproduktroh_bestand = " &
PkRohproduktBestand & ";"
Dbs.Deg.exec(qry)
sql.Commit
cancel = False
Goto Ende
Else
' ------------------------------------------------- Produkt mit
Charge
'2.fall, es gibt eine chargennummer des herstellers
'schauen, ob diese chargennummer bereits vorhanden ist
'zuerst die eindeutigkeit der chargennummer klarstellen
PkCharge = GetPkCharge(sCharge, Lnr, PkRohproduktBestand)
If PkCharge > 0 Then
'charge wurde gefunden
'die menge im lager wird erhöht
sql.Begin
'produktabruf beim kontrakt festhalten, wenn kontrakt
existiert
cancel = MKontrakt.EingangAusKontraktenAusbuchen(Lnr,
PkRohproduktBestand, Menge, PkCharge)
If cancel = False Then
qry = "UPDATE tbproduktcharge SET bestand = bestand + "
& strmenge &
" WHERE pkproduktcharge = " & PkCharge & ";"
Dbs.Deg.exec(qry)
'in tbliebestelldetail als ausgetragen markieren
'FIXME: Darf nur dann den eingang beenden, wenn die
menge komplett übernommen wurde
qry = "UPDATE tbliebestelldetail SET inlageruebernommen
= -1 WHERE pkbestelldetail = " & PkLiebestellDetail & ";"
Dbs.Deg.exec(qry)
sql.Commit
Else
sql.Rollback
End If
Goto Ende
Else
sCharge = DegString.LowerCompact(sCharge)
'diese charge des herstellers wurde nicht gefunden
'eine neue charge muß erstellt werden
sql.Begin
'in tbliebestelldetail als ausgetragen markieren
qry = "UPDATE tbliebestelldetail SET inlageruebernommen
= -1 WHERE pkbestelldetail = " & PkLiebestellDetail & ";"
Dbs.Deg.exec(qry)
PkCharge = ChargeInLagerAufnehmen(PkRohproduktBestand,
sCharge, Lnr, strmenge)
If PkCharge > 0 Then
'produktabruf beim kontrakt festhalten, wenn
kontrakt für dieses produkt existiert
cancel =
MKontrakt.EingangAusKontraktenAusbuchen(Lnr, PkLiebestellDetail,
PkRohproduktBestand, Menge, PkCharge)
If cancel = False Then
sql.Commit
End If
Endif
If cancel = True Then
sql.Rollback
Endif
Goto Ende
End If
End If
Ende:
Return cancel
End
------------------------------------------------------------------------------
_______________________________________________
Gambas-user mailing list
Gambas-user@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/gambas-user
