Imports System Imports DevExpress.Xpo Imports DevExpress.Xpo.DB Imports DevExpress.Data.Filtering Imports DevExpress.ExpressApp Imports System.Linq Imports System.Linq.Expressions Imports System.IO Public Module GeneralFunction '-- Globális változó ! Public GLOBAL_CustomersFrom_Oid As String Public GLOBAL_ConnectionString As String Public GLOBAL_WINFormCaption As String Public GLOBAL_WEBFormCaption As String Public GLOBAL_RegistryTask_Current_Oid As Guid Public GLOBAL_CustomersFrom_String As String = "" Public GLOBAL_PreviewName As String = "" Public GLOBAL_PrevievFilter As String = "" Public GLOBAL_ApplicationStartupPath As String = "" Public GLOBAL_ApplicationStartupPath_Mail As String = "" Public GLOBAL_SQLType As eSQLType Public GLOBAL_HAS_EXPLICIT_TRANSACTION As Boolean = False Public GLOBAL_EUMemberStates As String() = {"AT", "BE", "BG", "CY", "CZ", "DK", "UK", "EE", "FI", "FR", "GR", "GB", "NL", "IE", "PL", "LV", "LT", "LU", "HU", "MT", "DE", "IT", "PT", "RO", "ES", "SE", "SK", "SI"} Public GLOBAL_HAS_Audit As Boolean = True Public GLOBAL_MainModuleVersion As String = "" 'winApplication_LastLogonParametersWriting' Public GLOBAL_SQLServer As String = "" Public GLOBAL_SQLUser As String = "" Public GLOBAL_SQLDatabase As String = "" Public GLOBAL_SQLPassword As String = "" Public GLOBAL_Company As String = "" Public GLOBAL_Plattform As String = "" Public GLOBAL_Company_Info As String = "" Public GLOBAL_ActivityID As String = "" Public GLOBAL_Download_MemoryStream As MemoryStream Public GLOBAL_Download_FileName As String Public GLOBAL_Download_FileExtension As String 'Dashboard Public GLOBAL_DASHBOARD_XML_DashboardXmlFile As String = "" Public GLOBAL_DASHBOARD_XML_ServerName As String = "" Public GLOBAL_DASHBOARD_XML_UserName As String = "" Public GLOBAL_DASHBOARD_XML_DatabaseName As String = "" Public GLOBAL_DASHBOARD_XML_Password As String = "" Public GLOBAL_DASHBOARD_XML_SQLType As String = "" Public GLOBAL_ListViewReset As Boolean = False Enum eDirection Left = 0 Right = 1 End Enum Public Function GetConnectionGLOBAL() As String Dim connstr As String = "" Select Case UCase(GLOBAL_Company) Case "FR (MICROSERVER2008)" GLOBAL_SQLUser = "root" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MySQL GLOBAL_SQLServer = "MICROSERVER2008" GLOBAL_SQLDatabase = "frinput" GLOBAL_Company_Info = "Franciska Kft : MICROSERVER2008, FRINPUT" GLOBAL_Plattform = "MySQL" connstr = DevExpress.Xpo.DB.MySqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) Case "MC LOCAL", "MC (LOCAL)" GLOBAL_SQLUser = "sa" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MSSQL GLOBAL_SQLServer = "SISI5SSD2\SQLExpress" GLOBAL_SQLDatabase = "MC" GLOBAL_Company_Info = "Mol-Control Kft. TESZT adatbázis : SISI5SSD2\SQLExpress, MC" GLOBAL_Plattform = "MS SQL" connstr = DevExpress.Xpo.DB.MSSqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) Case "MC OFFICE TEST" GLOBAL_SQLUser = "sa" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MSSQL GLOBAL_SQLServer = "192.168.6.9" GLOBAL_SQLDatabase = "Nuvolar_TEST" GLOBAL_Company_Info = "Mol-Control Kft. TESZT adatbázis : 192.168.6.9, Nuvolar_TEST" GLOBAL_Plattform = "MS SQL" connstr = DevExpress.Xpo.DB.MSSqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) Case "MC REMOTE", "MC (REMOTE)", "MC" GLOBAL_SQLUser = "sa" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MSSQL GLOBAL_SQLServer = "78.131.7.14" GLOBAL_SQLDatabase = "Nuvolar" GLOBAL_Company_Info = "Mol-Control Kft. adatbázis : 78.131.7.14, MC" GLOBAL_Plattform = "MS SQL" connstr = DevExpress.Xpo.DB.MSSqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) Case "SISTEST (LOCAL)", "SISTEST LOCAL" GLOBAL_SQLUser = "sa" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MSSQL GLOBAL_SQLServer = "SISI5SSD2\SQLExpress" GLOBAL_SQLDatabase = "SISTEST" GLOBAL_Company_Info = "TESZT adatbázis : SISI5SSD2\SQLExpress, SISTEST" GLOBAL_Plattform = "MS SQL" connstr = DevExpress.Xpo.DB.MSSqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) Case "PH (REMOTE)", "PH REMOTE", "PH" GLOBAL_SQLUser = "sisuser" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MSSQL GLOBAL_SQLServer = "iroda.pestihazak.hu " GLOBAL_SQLDatabase = "Nuvolar" GLOBAL_Company_Info = "Pesti Házak : iroda.pestihazak.hu, Nuvolar" GLOBAL_Plattform = "MS SQL" connstr = DevExpress.Xpo.DB.MSSqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) Case "SISTEST" GLOBAL_SQLUser = "sa" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MSSQL GLOBAL_SQLServer = "DATACENTER\SIS" GLOBAL_SQLDatabase = "SISTEST" GLOBAL_Company_Info = "SISTEST adatbázis : DATACENTER\SIS, SISTEST" GLOBAL_Plattform = "MS SQL" connstr = DevExpress.Xpo.DB.MSSqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) Case "FRANCISKA (LOCAL)", "FRANCISKA LOCAL" GLOBAL_SQLUser = "root" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MySQL GLOBAL_SQLServer = "frserver" GLOBAL_SQLDatabase = "frinput" GLOBAL_Company_Info = "Franciska Input Kft : FRSERVER, FRINPUT" GLOBAL_Plattform = "MySQL" connstr = DevExpress.Xpo.DB.MySqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) Case "FRANCISKA (REMOTE)", "FRANCISKA REMOTE", "FR" GLOBAL_SQLUser = "root" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MySQL GLOBAL_SQLServer = "91.137.135.109" GLOBAL_SQLDatabase = "frinput" GLOBAL_Company_Info = "Franciska Input Kft : 91.137.135.109, FRINPUT" GLOBAL_Plattform = "MySQL" connstr = DevExpress.Xpo.DB.MySqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) Case "BATIMPUT (REMOTE)", "BATINPUT REMOTE", "BI" GLOBAL_SQLUser = "root" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MySQL GLOBAL_SQLServer = "91.137.135.109" GLOBAL_SQLDatabase = "batinput" GLOBAL_Company_Info = "Bát Input Kft : 91.137.135.109, BATINPUT" GLOBAL_Plattform = "MySQL" connstr = DevExpress.Xpo.DB.MySqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) Case "FR DB01" GLOBAL_SQLUser = "root" GLOBAL_SQLPassword = "pcl718" GLOBAL_SQLType = eSQLType.MySQL GLOBAL_SQLServer = "91.137.135.109" GLOBAL_SQLDatabase = "db01" GLOBAL_Company_Info = "Franciska Input Kft : 91.137.135.109, db01" GLOBAL_Plattform = "MySQL" connstr = DevExpress.Xpo.DB.MySqlConnectionProvider.GetConnectionString(GLOBAL_SQLServer, GLOBAL_SQLUser, GLOBAL_SQLPassword, GLOBAL_SQLDatabase) End Select Return connstr End Function Public Function AlignStr(ByVal s As String, ByVal Direction As eDirection, ByVal AlignChar As String, ByVal MaxLen As Integer) As String Dim I As Integer Dim J As Long Dim seged As String = "" Dim _AlignStr As String = "" If AlignChar = "" Then AlignChar = " " If MaxLen > Len(s) Then I = MaxLen - Len(s) For J = 1 To I seged += AlignChar Next Select Case Direction Case eDirection.Left : _AlignStr = seged & s Case eDirection.Right : _AlignStr = s & seged End Select Return _AlignStr Else Return Mid(s, 1, MaxLen) End If End Function Public Function GetSQLTime(ByVal session As Session) As Date Try Dim funcNow As CriteriaOperator = New FunctionOperator(FunctionOperatorType.Now) Dim serverTime As Date = session.Evaluate(Of XPObjectType)(funcNow, Nothing) Return serverTime Catch Return Now End Try End Function Public Function Change3Value(ByVal s As String) As String Dim EStr(4) As String Select Case Mid(s, 3, 1) Case "0" : EStr(3) = "" Case "1" : EStr(3) = "egy" Case "2" : EStr(3) = "kettő" Case "3" : EStr(3) = "három" Case "4" : EStr(3) = "négy" Case "5" : EStr(3) = "öt" Case "6" : EStr(3) = "hat" Case "7" : EStr(3) = "hét" Case "8" : EStr(3) = "nyolc" Case "9" : EStr(3) = "kilenc" End Select Select Case Mid(s, 2, 1) Case "0" : EStr(2) = "" Case "1" If EStr(3) = "" Then EStr(2) = "tíz" Else EStr(2) = "tizen" End If Case "2" If EStr(3) = "" Then EStr(2) = "húsz" Else EStr(2) = "huszon" End If Case "3" : EStr(2) = "harminc" Case "4" : EStr(2) = "negyven" Case "5" : EStr(2) = "ötven" Case "6" : EStr(2) = "hatvan" Case "7" : EStr(2) = "hetven" Case "8" : EStr(2) = "nyolcvan" Case "9" : EStr(2) = "kilencven" End Select Select Case Mid(s, 1, 1) Case "0" : EStr(1) = "" Case "1" : EStr(1) = "száz" Case "2" : EStr(1) = "kettőszáz" Case "3" : EStr(1) = "háromszáz" Case "4" : EStr(1) = "négyszáz" Case "5" : EStr(1) = "ötszáz" Case "6" : EStr(1) = "hatszáz" Case "7" : EStr(1) = "hétszáz" Case "8" : EStr(1) = "nyolcszáz" Case "9" : EStr(1) = "kilencszáz" End Select Return UCase$(EStr(1) & EStr(2) & EStr(3)) End Function Public Function GetHUNumberToText(ByVal l As Double) As String Dim SzámSzöveg As String Dim seged As String Dim VégStr As String l = Math.Round(Math.Abs(l), 2, MidpointRounding.AwayFromZero) VégStr = "" SzámSzöveg = Format(l, "000000000000.00") seged = Mid(SzámSzöveg, 1, 3) seged = Change3Value(seged) If seged <> "" Then VégStr = VégStr & seged & "milliárd " Else VégStr = VégStr & "" End If seged = Mid(SzámSzöveg, 4, 3) seged = Change3Value(seged) If seged <> "" Then VégStr = VégStr & seged & "millió " Else VégStr = VégStr & "" End If seged = Mid(SzámSzöveg, 7, 3) seged = Change3Value(seged) If seged <> "" Then VégStr = VégStr & seged & "ezer " Else VégStr = VégStr & "" End If seged = Mid(SzámSzöveg, 10, 3) seged = Change3Value(seged) VégStr = VégStr & seged seged = Mid(SzámSzöveg, 14, 1) VégStr = VégStr & " " & seged & "/100" Return UCase$(VégStr) End Function Public Function LastDayOfYear(ByVal d As DateTime) As DateTime Dim time As New DateTime((d.Year + 1), 1, 1) Return time.AddDays(-1) End Function Public Function FirstDayOfYear(ByVal y As DateTime) As DateTime Return New DateTime(y.Year, 1, 1) End Function Public Function CorrectFileName(_FileName As String) As String Dim _FileName_Good As String = "" Dim _s As String = "" Dim _i As Long = 0 For i = 1 To Len(_FileName) _s = Mid(_FileName, i, 1) Select Case _s Case "/", "'", ":", ",", ">", "<" _FileName_Good += "_" Case Else _FileName_Good += _s End Select Next Return _FileName_Good End Function Public Function SQLNum(_NumberText As String) As String Dim _decimalSeparator As String = Globalization.CultureInfo.CurrentCulture.NumberFormat.NumberDecimalSeparator Dim _groupSeparator As String = Globalization.CultureInfo.CurrentCulture.NumberFormat.NumberGroupSeparator Return Replace(Replace(_NumberText, _groupSeparator, ""), _decimalSeparator, ".") End Function '-- Hiba kezelés Public Function ThrowNewException(_p_Message As String) As Boolean MsgBox(_p_Message, MsgBoxStyle.Critical, "Nuvolar Framework 20.") Return True End Function Public Function GenerateDateCollection(_StartDate As Date, _StopDate As Date, Optional _Week As Boolean = False) As ArrayList Dim _DateArray As New ArrayList If _Week Then Dim _WeekCount As Integer = DateDiff(DateInterval.WeekOfYear, _StartDate, _StopDate) Dim _DayOfWeek As Integer = _StartDate.DayOfWeek If _DayOfWeek <> 0 Then _DateArray.Add(New Date(_StartDate.Year, _StartDate.Month, _StartDate.Day + (7 - _DayOfWeek))) Else _DateArray.Add(New Date(_StartDate.Year, _StartDate.Month, _StartDate.Day + 7)) End If For ik = 1 To _WeekCount _DateArray.Add((New Date(CType(_DateArray(ik - 1), Date).Year, CType(_DateArray(ik - 1), Date).Month, CType(_DateArray(ik - 1), Date).Day).AddDays(7))) Next Else Dim _MountCount As Integer = DateDiff(DateInterval.Month, _StartDate, _StopDate) For ik = 1 To _MountCount + 1 _DateArray.Add((New Date(_StartDate.Year, _StartDate.Month, 1).AddMonths(ik)).AddDays(-1)) Next End If Return _DateArray End Function '//Raktárkezelés Public Sub CheckInventoryTransferStorageInRows(_uow As UnitOfWork, _StorageInRows_Collection_Base As XPCollection(Of StorageInRows)) Dim _SQL As String = "" Dim _StorageInRows_Base As StorageInRows For Each _StorageInRows_Base In _StorageInRows_Collection_Base If _SQL = "" Then _SQL = " Oid in ('" & _StorageInRows_Base.Oid.ToString & "'" Else _SQL += ",'" & _StorageInRows_Base.Oid.ToString & "'" End If Next If _SQL <> "" Then _SQL += ")" Else Exit Sub End If Select Case GLOBAL_SQLType Case eSQLType.MSSQL, eSQLType.MySQL _uow.ExecuteNonQuery("update StorageInRows set QTT_Overstor=0,QTT_Overstor_Will=0,QTT_Overstored=0,QTT_Overstored_Will=0 Where " & _SQL) Case eSQLType.PostgreSQL _SQL = Replace(_SQL, "Oid", """Oid""") _uow.ExecuteNonQuery("update ""StorageInRows"" set ""QTT_Overstor""=0,""QTT_Overstor_Will""=0,""QTT_Overstored""=0,""QTT_Overstored_Will""=0 Where " & _SQL) End Select For Each _StorageInRows_Base In _StorageInRows_Collection_Base Dim _StorageOutRowsInRows_XPQuery As New XPQuery(Of StorageOutRowsInRows)(_uow) Dim query = From _StorageOutRowsInRows In _StorageOutRowsInRows_XPQuery Where _StorageOutRowsInRows.StorageOutRows.StorageOutHeader.StorageMoveType.MoveType = eMoveType.InventoryTransfer And _StorageOutRowsInRows.StorageOutRows.StorageOutHeader.IsEditable = False And String.IsNullOrEmpty(_StorageOutRowsInRows.StorageOutRows.StorageOutHeader.DocumentNumber) = False And _StorageOutRowsInRows.StorageOutRows.StorageOutHeader IsNot Nothing And _StorageOutRowsInRows.StorageInRows.Oid = _StorageInRows_Base.Oid Group _StorageOutRowsInRows By _StorageOutRowsInRows.StorageInRows.Oid Into g = Group Select New With {.StorageInRows = Oid, .QTT_Sum = g.Sum(Function(inv) inv.QTT)} For Each item In query Dim _StorageInRows As StorageInRows = _uow.FindObject(Of StorageInRows)(CriteriaOperator.Parse("Oid=?", item.StorageInRows.ToString)) If _StorageInRows IsNot Nothing Then _StorageInRows.QTT_Overstor = item.QTT_Sum _uow.CommitChanges() End If Next query = From _StorageOutRowsInRows In _StorageOutRowsInRows_XPQuery Where _StorageOutRowsInRows.StorageOutRows.StorageOutHeader.StorageMoveType.MoveType = eMoveType.InventoryTransfer And _StorageOutRowsInRows.StorageOutRows.StorageOutHeader.IsEditable = True And _StorageOutRowsInRows.StorageOutRows.StorageOutHeader IsNot Nothing And _StorageOutRowsInRows.StorageInRows.Oid = _StorageInRows_Base.Oid Group _StorageOutRowsInRows By _StorageOutRowsInRows.StorageInRows.Oid Into g = Group Select New With {.StorageInRows = Oid, .QTT_Sum = g.Sum(Function(inv) inv.QTT_Will)} For Each item In query Dim _StorageInRows As StorageInRows = _uow.FindObject(Of StorageInRows)(CriteriaOperator.Parse("Oid=?", item.StorageInRows.ToString)) If _StorageInRows IsNot Nothing Then _StorageInRows.QTT_Overstor_Will = item.QTT_Sum _uow.CommitChanges() End If Next '__Overstored renberakása Dim _StorageInRows_XPQuery As New XPQuery(Of StorageInRows)(_uow) Dim query1 = From _StorageInRows In _StorageInRows_XPQuery Where _StorageInRows.StorageInHeader IsNot Nothing And String.IsNullOrEmpty(_StorageInRows.StorageInHeader.DocumentNumber) = False AndAlso _StorageInRows.StorageInHeader.StorageMoveType.MoveType = eMoveType.InventoryTransfer And _StorageInRows.StorageInHeader.IsEditable = False And _StorageInRows.StorageInRowsFrom.Oid = _StorageInRows_Base.Oid Group _StorageInRows By _StorageInRows.StorageInRowsFrom.Oid Into g = Group Select New With {.StorageInRows = Oid, .QTT_Sum = g.Sum(Function(inv) inv.QTT)} For Each item In query1 Dim _StorageInRows As StorageInRows = _uow.FindObject(Of StorageInRows)(CriteriaOperator.Parse("Oid=?", item.StorageInRows.ToString)) If _StorageInRows IsNot Nothing Then _StorageInRows.QTT_Overstored = item.QTT_Sum _uow.CommitChanges() End If Next query1 = From _StorageInRows In _StorageInRows_XPQuery Where _StorageInRows.StorageInHeader IsNot Nothing And String.IsNullOrEmpty(_StorageInRows.StorageInHeader.DocumentNumber) = False AndAlso _StorageInRows.StorageInHeader.StorageMoveType.MoveType = eMoveType.InventoryTransfer And _StorageInRows.StorageInHeader.IsEditable = True And _StorageInRows.StorageInRowsFrom.Oid = _StorageInRows_Base.Oid Group _StorageInRows By _StorageInRows.StorageInRowsFrom.Oid Into g = Group Select New With {.StorageInRows = Oid, .QTT_Sum = g.Sum(Function(inv) inv.QTT_Will)} For Each item In query1 Dim _StorageInRows As StorageInRows = _uow.FindObject(Of StorageInRows)(CriteriaOperator.Parse("Oid=?", item.StorageInRows.ToString)) If _StorageInRows IsNot Nothing Then _StorageInRows.QTT_Overstored_Will = item.QTT_Sum _uow.CommitChanges() End If Next Next End Sub Function EAN13Generator(ByVal _Base As String) As String If _Base.Length = 12 Then Dim i As Long Dim _CheckSum As Long = 0 For i = 1 To Len(_Base) If i Mod 2 = 0 Then _CheckSum += Val(Mid(_Base, i, 1)) * 3 Else _CheckSum += Val(Mid(_Base, i, 1)) End If Next _CheckSum = 10 - (_CheckSum Mod 10) If _CheckSum = 10 Then _CheckSum = 0 Return _Base & LTrim(RTrim(CStr(_CheckSum))) Else Return "" End If End Function End Module