OK, so on the practical side of things we are sorted. Just make it all
conditionally compile and remove the runtime checks and you are good to go.
On the academic side of things, thanks for posting over 1000 lines of a
module but if you want me to look at your issue and help you with it, as I
said, send me something that compiles and I can work with (your module is
not in a project, it is not copy/pastable in a project (hint: line breaks),
but also has references to forms that don't exist).
Being a VB6 programmer has nothing to do with the price of fish. It is a
very bad habit to use option strict off by default and not when you
specifically need it. For all I know it could be the cause of your issues
here.
As always, if you zip me the project and a specific question, I'll check it
out.
Cheers
Daniel
--
http://www.danielmoth.com/Blog/
seems to work for you in the module but didn't in the class, right?
EXACTLY...
I'm in debug configuration,
Have you got option strict on? no... i'm a vb6 programmer.... let me
some days of semplicity...
i'll try...
This module can be compiled and can be run in every platform without
errors...
Imports System.Data.Common
Imports System.Data
Module MainModule
Friend Structure TParametri
Friend Versione As String
Friend AppName As String
Friend FileINI As String
Friend FileLog As String
Friend StrCn As String
Friend MainHanlde As IntPtr
Friend Palmare As Boolean
Friend DeviceName As String
Friend DeviceIP As String
Friend Cn_SQL As SqlClient.SqlConnection
Friend Cn_SQLCE As SqlServerCe.SqlCeConnection
Friend PathImportListinoExcel As String
Friend PathOutputListinoExcel As String
Friend StrCn_Master As String
Friend DeviceID As String
Friend UtConnesso As String
Friend UtValidato As Boolean
Friend UtAdmin As Boolean
Friend FrmAnagraficaRicRisultati_I As FrmAnagraficaRicRisultati
Friend FrmAnagraficaDesktop_I As FrmAnagraficaDesktop
Friend FrmIntervento_I As FrmIntervento
Friend FrmRicInterventi_I As FrmRicInterventi
Friend FrmTabelle_I As FrmTabelle
Friend FrmFurgone_I As FrmFurgone
Friend FrmRicFurgone_I As FrmRicFurgone
Friend FrmStatSogg_I As FrmStatSogg
Friend FrmAnaArticoli_I As FrmAnagraficaArticoli
Friend FrmAggiornaPalmare_I As FrmAggiornaPalmare
Friend ModelloStampaInterventi As String
Friend ModelloStampaIntervento As String
Friend ModelloStampaAnagrafica As String
Friend FurgoneDefault As String
End Structure
Public Parametri As TParametri
Public Sub Main()
CaricaParametri()
My.Forms.FrmLogin.ShowDialog()
If Not Parametri.UtValidato Then
'MsgBox("Utente non abilitato", MsgBoxStyle.Critical)
Exit Sub
End If
If Parametri.Palmare Then
Application.Run(New FrmMainPalmare)
Else
Application.Run(New FrmMainDesktop)
End If
End Sub
Public Sub GetMyConnectionPalmare()
Parametri.Cn_SQLCE = New SqlServerCe.SqlCeConnection
Parametri.Cn_SQLCE.ConnectionString = "Data source=" +
Parametri.StrCn
Parametri.Cn_SQLCE.Open()
End Sub
Public Sub GetMyCOnnectionDesktop()
Parametri.Cn_SQL = New SqlClient.SqlConnection
Parametri.Cn_SQL.ConnectionString = Parametri.StrCn
Parametri.Cn_SQL.Open()
End Sub
Public Sub CaricaParametri()
'SqlC.ConnectionString = "Data
Source=\programmi\data\sycomm97_sto_ottobre.sdf"
'C.ConnectionString = "database=CATTANI_INT;server=SYTRACK"
With Parametri
.Versione = "0.1"
.AppName = "GesInt" & " v." & .Versione
.FileINI = MdlCommon.AppPath() & "\Config.INI"
.FileLog = LeggiINI("Generale", "FileLog", .FileINI)
.FileLog = .FileLog.Replace("%APP.PATH%",
MdlCommon.AppPath)
.PathImportListinoExcel = LeggiINI("Generale",
"PathImportListinoExcel", .FileINI)
.PathImportListinoExcel =
..PathImportListinoExcel.Replace("%APP.PATH%", MdlCommon.AppPath)
.PathOutputListinoExcel = LeggiINI("Generale",
"PathOutputListinoExcel", .FileINI)
.PathOutputListinoExcel =
..PathOutputListinoExcel.Replace("%APP.PATH%", MdlCommon.AppPath)
If .PathOutputListinoExcel = "" Then
.PathOutputListinoExcel = MdlCommon.AppPath &
"\LEx.txt"
End If
.StrCn = LeggiINI("Generale", "StrCn", .FileINI)
.DeviceName = GetDeviceName()
.DeviceIP = GetDeviceIP()
.Palmare = MdlCommon.IsPalmare()
.DeviceID = LeggiINI("Generale", "DeviceID", .FileINI)
If .DeviceID = "" Then .DeviceID = "0"
.UtConnesso = LeggiINI("Generale", "UtConnesso", .FileINI)
.StrCn_Master = LeggiINI("Generale", "StrCn_Master",
..FileINI)
If .StrCn_Master = "" Then
.StrCn_Master =
"database=CATTANI_INT;server=SYTRACK;Persist Security Info=False;User
ID=sa"
End If
If .Palmare Then
If .StrCn = "" Then
.StrCn = "\programmi\data\CATTANI_INT.sdf"
End If
CreaDBSQLCE()
GetMyConnectionPalmare()
Else
If .StrCn = "" Then
.StrCn = "database=CATTANI_INT;server=SYTRACK"
End If
GetMyCOnnectionDesktop()
End If
.UtValidato = False
.ModelloStampaInterventi = AppPath() &
"\stampe\ricInt.html"
.ModelloStampaIntervento = AppPath() &
"\stampe\Intervento.html"
.ModelloStampaAnagrafica = AppPath() &
"\stampe\RicSoggetti.html"
.FurgoneDefault = dLookup("Codice", "Furgoni",
"CodUtenteDefault='" & Parametri.UtConnesso & "'", "").ToString
If .FurgoneDefault = "" Then
.FurgoneDefault = dLookup("Codice", "Furgoni", "",
"").ToString
End If
End With
End Sub
Function SQLErrorDesktop(ByVal e As SqlClient.SqlException) As
String
Dim errorMessages As String
Dim i As Integer
errorMessages = ""
For i = 0 To e.Errors.Count - 1
errorMessages += "Index #" & i.ToString() &
ControlChars.NewLine _
& "Message: " & e.Errors(i).Message &
ControlChars.NewLine _
& "LineNumber: " & e.Errors(i).LineNumber &
ControlChars.NewLine _
& "Source: " & e.Errors(i).Source &
ControlChars.NewLine _
& "Procedure: " & e.Errors(i).Procedure &
ControlChars.NewLine
Next i
SQLErrorDesktop = errorMessages
End Function
Function SQLErrorCE(ByVal e As SqlServerCe.SqlCeException) As
String
Dim errorMessages As String
Dim i As Integer
errorMessages = ""
For i = 0 To e.Errors.Count - 1
errorMessages += "Index #" & i.ToString() &
ControlChars.NewLine _
& "Message: " & e.Errors(i).Message &
ControlChars.NewLine _
& "Source: " & e.Errors(i).Source &
ControlChars.NewLine
Next i
SQLErrorCE = errorMessages
End Function
Private Sub RunSQL_CE(ByVal SQLString As String, Optional ByRef
Errout As String = "")
Dim C As New SqlServerCe.SqlCeCommand
C.CommandText = SQLString
C.Connection = Parametri.Cn_SQLCE
Try
C.ExecuteNonQuery()
Catch e As SqlServerCe.SqlCeException
Errout = SQLErrorCE(e)
End Try
C.Dispose()
End Sub
Private Sub RunSQL_Desktop(ByVal SQLString As String, Optional
ByRef Errout As String = "")
Dim C As New SqlClient.SqlCommand
C.CommandText = SQLString
C.Connection = Parametri.Cn_SQL
Errout = ""
Try
C.ExecuteNonQuery()
Catch e As SqlClient.SqlException
Errout = SQLErrorDesktop(e)
End Try
End Sub
Private Sub RunSQLScalar_CE(ByVal SQLString As String, ByRef
OutScalar As Object, Optional ByRef Errout As String = "")
Dim C As New SqlServerCe.SqlCeCommand
C.CommandText = SQLString
C.Connection = Parametri.Cn_SQLCE
Errout = ""
Try
OutScalar = C.ExecuteScalar()
Catch e As SqlServerCe.SqlCeException
Errout = SQLErrorCE(e)
End Try
End Sub
Private Sub RunSQLScalar_Desktop(ByVal SQLString As String, ByRef
OutScalar As Object, Optional ByRef Errout As String = "")
Dim C As New SqlClient.SqlCommand
C.CommandText = SQLString
C.Connection = Parametri.Cn_SQL
Errout = ""
Try
OutScalar = C.ExecuteScalar()
Catch e As SqlClient.SqlException
Errout = SQLErrorDesktop(e)
End Try
End Sub
Private Function GetDS_Desktop(ByVal SQL As String) As DataSet
Dim Ds As New DataSet
Dim Da As New SqlClient.SqlDataAdapter(SQL, Parametri.Cn_SQL)
Da.Fill(Ds)
Da.Dispose()
GetDS_Desktop = Ds
End Function
Private Function GetDS_CE(ByVal SQL As String) As DataSet
Dim Ds As New DataSet
Dim Da As New SqlServerCe.SqlCeDataAdapter(SQL,
Parametri.Cn_SQLCE)
Da.Fill(Ds)
Da.Dispose()
GetDS_CE = Ds
End Function
Public Sub RunSQL(ByVal SQLString As String, Optional ByRef Errout
As String = "")
Errout = ""
If Parametri.Palmare Then
RunSQL_CE(SQLString, Errout)
Else
RunSQL_Desktop(SQLString, Errout)
End If
End Sub
Public Sub RunSQLScalar(ByVal SQLString As String, ByRef OutScalar
As Object, Optional ByRef Errout As String = "")
Errout = ""
If Parametri.Palmare Then
RunSQLScalar_CE(SQLString, OutScalar, Errout)
Else
RunSQLScalar_Desktop(SQLString, OutScalar, Errout)
End If
End Sub
Public Function DataToSTR(ByVal D As Date) As String
DataToSTR = D.Year() & "_" & Format(D.Month, "00") & "_" &
Format(D.Day, "00")
End Function
Public Function STRToDate(ByVal SIn As String) As System.DateTime
If SIn = "" Then
STRToDate = Now
Else
SIn = Right(SIn, 2) & "/" & Mid(SIn, 6, 2) & "/" &
Left(SIn, 4)
STRToDate = System.DateTime.Parse(SIn)
End If
End Function
Public Function GetDS(ByVal SQL As String) As DataSet
If Parametri.Palmare Then
GetDS = GetDS_CE(SQL)
Else
GetDS = GetDS_Desktop(SQL)
End If
End Function
Public Sub CreaDBSQLCE()
Dim Fp As String
Dim Sql As String
If Not OpenNETCF.IO.File2.Exists(Parametri.StrCn) Then
'
Fp = System.IO.Path.GetDirectoryName(Parametri.StrCn)
If Fp <> "" Then
System.IO.Directory.CreateDirectory(Fp)
End If
Dim En As New SqlServerCe.SqlCeEngine("Data source=" +
Parametri.StrCn)
Dim command As New SqlServerCe.SqlCeCommand
En.CreateDatabase()
En.Dispose()
Dim Cn As New SqlServerCe.SqlCeConnection("Data source=" +
Parametri.StrCn)
Cn.Open()
command.Connection = Cn
'======================================================
' TABELLA ANAGRAFICA
'======================================================
Sql = "Create table Anagrafica ("
Sql = Sql & "Codice nvarchar(10) PRIMARY KEY NOT NULL,"
Sql = Sql & "RagSociale nvarchar(50) NULL,"
Sql = Sql & "Indirizzo nvarchar(100) NULL,"
Sql = Sql & "CAP nvarchar(10) NULL,"
Sql = Sql & "Localita nvarchar(50) NULL,"
Sql = Sql & "Provincia nvarchar(5) NULL,"
Sql = Sql & "Contatto nvarchar(25) NULL,"
Sql = Sql & "Tel nvarchar(15) NULL,"
Sql = Sql & "Tel1 nvarchar(15) NULL,"
Sql = Sql & "Fax nvarchar(15) NULL,"
Sql = Sql & "Cell nvarchar(15) NULL,"
Sql = Sql & "FlagCliente nvarchar(1) NULL,"
Sql = Sql & "FlagFornitore nvarchar(1) NULL,"
Sql = Sql & "CreatoDa nvarchar(5) NULL,"
Sql = Sql & "CreatoData nvarchar(10) NULL,"
Sql = Sql & "ModificatoDa nvarchar(5) NULL,"
Sql = Sql & "ModificatoData nvarchar(10) NULL,"
Sql = Sql & "DeviceID nvarchar(1) NULL,"
Sql = Sql & "FlagVariatoP1 nvarchar(1) NULL,"
Sql = Sql & "FlagVariatoP2 nvarchar(1) NULL,"
Sql = Sql & "FlagVariatoP3 nvarchar(1) NULL"
Sql = Sql & ")"
command.CommandText = Sql
command.ExecuteNonQuery()
'======================================================
' TABELLA NUMERAZIONI
'======================================================
Sql = "Create table Numerazioni ("
Sql = Sql & "Tabella nvarchar(15) PRIMARY KEY NOT NULL,"
Sql = Sql & "UltimoNum BigInt NULL"
Sql = Sql & ")"
command.CommandText = Sql
command.ExecuteNonQuery()
'======================================================
' TABELLA ANAGRAFICA CHIAVI
'======================================================
Sql = "CREATE TABLE Anagrafica_Chiavi ("
Sql = Sql & "CodiceAnagrafica nvarchar(10) NOT NULL,"
Sql = Sql & "Chiave nvarchar(25) NOT NULL, "
Sql = Sql & " CONSTRAINT PK_Anagrafica_Chiavi PRIMARY KEY
("
Sql = Sql & " CodiceAnagrafica,chiave)"
Sql = Sql & ")"
command.CommandText = Sql
command.ExecuteNonQuery()
'======================================================
' TABELLA UTENTI
'======================================================
Sql = "Create table UTENTI ("
Sql = Sql & "Codice nvarchar(5) PRIMARY KEY NOT NULL,"
Sql = Sql & "Descrizione nvarchar(25) NULL,"
Sql = Sql & "Password nvarchar(15) NULL,"
Sql = Sql & "Flagadmin nvarchar(1) NULL"
Sql = Sql & ")"
command.CommandText = Sql
command.ExecuteNonQuery()
'======================================================
' TABELLA ARTICOLI
'======================================================
Sql = "Create table ARTICOLI ("
Sql = Sql & "Codice nvarchar(20) PRIMARY KEY NOT NULL,"
Sql = Sql & "Descrizione nvarchar(50) NULL,"
Sql = Sql & "UM nvarchar(5) NULL,"
Sql = Sql & "Costo Real NULL,"
Sql = Sql & "CatMerc nvarchar(5) NULL,"
Sql = Sql & "DeviceID nvarchar(1) NULL,"
Sql = Sql & "FlagVariatoP1 nvarchar(1) NULL,"
Sql = Sql & "FlagVariatoP2 nvarchar(1) NULL,"
Sql = Sql & "FlagVariatoP3 nvarchar(1) NULL"
Sql = Sql & ")"
command.CommandText = Sql
command.ExecuteNonQuery()
'======================================================
' TABELLA INTERVENTI
'======================================================
Sql = "Create table INTERVENTI ("
Sql = Sql & "Codice nvarchar(10) PRIMARY KEY NOT NULL,"
Sql = Sql & "Data nvarchar(10) NULL,"
Sql = Sql & "Ora nvarchar(5) NULL,"
Sql = Sql & "TotaleOre Real NULL,"
Sql = Sql & "CodOperatore nvarchar(5) NULL,"
Sql = Sql & "Descrizione nvarchar(2048) NULL,"
Sql = Sql & "TotaleCosto Real NULL,"
Sql = Sql & "TotalePrezzo Real NULL,"
Sql = Sql & "FlagPagato nvarchar(1) NULL,"
Sql = Sql & "CodSoggetto nvarchar(10) NULL,"
Sql = Sql & "CodSegnalatoDa nvarchar(10) NULL,"
Sql = Sql & "CodPassatoA nvarchar(10) NULL,"
Sql = Sql & "CodTipoIntervento nvarchar(5) NULL,"
Sql = Sql & "CreatoDa nvarchar(5) NULL,"
Sql = Sql & "CreatoData nvarchar(10) NULL,"
Sql = Sql & "ModificatoDa nvarchar(5) NULL,"
Sql = Sql & "ModificatoData nvarchar(10) NULL,"
Sql = Sql & "DeviceID nvarchar(1) NULL,"
Sql = Sql & "FlagVariatoP1 nvarchar(1) NULL,"
Sql = Sql & "FlagVariatoP2 nvarchar(1) NULL,"
Sql = Sql & "FlagVariatoP3 nvarchar(1) NULL"
Sql = Sql & ")"
command.CommandText = Sql
command.ExecuteNonQuery()
'======================================================
' TABELLA INTERVENTI_MATERIALI
'======================================================
Sql = "Create table INTERVENTI_MATERIALI ("
Sql = Sql & "CodIntervento nvarchar(10) NOT NULL,"
Sql = Sql & "CodArticolo nvarchar(20) NULL,"
Sql = Sql & "Descrizione nvarchar(50) NULL,"
Sql = Sql & "Qta Real NULL,"
Sql = Sql & "UM nvarchar(5) NULL,"
Sql = Sql & "Costo Real NULL,"
Sql = Sql & "RowId Bigint NOT NULL,"
Sql = Sql & " CONSTRAINT PK_INTERVENTI_MATERIALI PRIMARY
KEY ("
Sql = Sql & " CodIntervento,RowId)"
Sql = Sql & ")"
command.CommandText = Sql
command.ExecuteNonQuery()
'======================================================
' TABELLA INTERVENTI_TIPO
'======================================================
Sql = "Create table Interventi_Tipo ("
Sql = Sql & "Codice nvarchar(5) NOT NULL,"
Sql = Sql & "Descrizione nvarchar(50) NULL,"
Sql = Sql & "Predefinito nvarchar(1) NULL,"
Sql = Sql & " CONSTRAINT PK_Interventi_Tipo PRIMARY KEY ("
Sql = Sql & " Codice)"
Sql = Sql & ")"
command.CommandText = Sql
command.ExecuteNonQuery()
'======================================================
' TABELLA FURGONE
'======================================================
Sql = "Create table Furgoni ("
Sql = Sql & "Codice nvarchar(5) NOT NULL,"
Sql = Sql & "Descrizione nvarchar(50) NULL,"
Sql = Sql & "CodUtenteDefault nvarchar(5) NULL,"
Sql = Sql & " CONSTRAINT PK_Furgoni PRIMARY KEY ("
Sql = Sql & " Codice)"
Sql = Sql & ")"
command.CommandText = Sql
command.ExecuteNonQuery()
'======================================================
' TABELLA FURGONI_ARTICOLI
'======================================================
Sql = "Create table Furgoni_Articoli ("
Sql = Sql & "CodFurgone nvarchar(5) NOT NULL,"
Sql = Sql & "CodArticolo nvarchar(20) NOT NULL,"
Sql = Sql & "QtaIni Real NULL,"
Sql = Sql & "Posizione nvarchar(10) NULL,"
Sql = Sql & " CONSTRAINT PK_Furgoni_Articoli PRIMARY KEY
("
Sql = Sql & " CodFurgone,CodArticolo)"
Sql = Sql & ")"
command.CommandText = Sql
command.ExecuteNonQuery()
command.Dispose()
Cn.Close()
Cn.Dispose()
End If
End Sub
Public Function Contatore(ByVal Tabella As String, ByVal base As
Long)
Dim OutV As Long
Dim Ds As DataSet
Dim Eo As String
OutV = -1
Eo = ""
Ds = GetDS("Select * FROM Numerazioni WHere Tabella='" &
Tabella & "'")
If (Ds.Tables(0).Rows.Count = 0) Then
OutV = base
RunSQL("Insert INTO Numerazioni (Tabella,UltimoNum) VALUES
('" & Tabella & "'," & OutV & ")", Eo)
Else
OutV = Ds.Tables(0).Rows(0)("UltimoNum")
OutV = OutV + base
RunSQL("UPDATE Numerazioni Set UltimoNum=" & OutV & " WHERE
TABELLA='" & Tabella & "'", Eo)
End If
Ds.Dispose()
If Eo <> "" Then OutV = -1
Contatore = OutV
End Function
Public Sub AggiornaPalmare(ByRef Pb As ProgressBar)
Dim ErrOut As String
Dim Cn As New SqlClient.SqlConnection
Cn.ConnectionString = Parametri.StrCn_Master
Try
Cn.Open()
Catch e As SqlClient.SqlException
ErrOut = SQLErrorDesktop(e)
MsgBox(ErrOut, , Parametri.AppName)
Exit Sub
End Try
AggiornaPalmareTabelle(Cn, Pb)
AggiornaPalmareANAGRAFICA(Cn, Pb)
AggiornaPalmareARTICOLI(Cn, Pb)
AggiornaPalmareINTERVENTI(Cn, Pb)
Cn.Close()
Cn.Dispose()
End Sub
Public Sub AggiornaPalmareINTERVENTI(ByRef C As
SqlClient.SqlConnection, ByRef Pb As ProgressBar)
Dim SQL As String
Dim MainSQL As String
Dim Ds As DataSet
Dim Variati As String
Dim Codici() As String
Variati = ""
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim Cmd As New SqlClient.SqlCommand
Dim ErrOut As String
ErrOut = ""
Cmd.Connection = C
Pb.Minimum = 0
Pb.Value = 0
'Da Palmare a PC
SQL = "Select * from INTERVENTI WHERE DeviceID='" &
Parametri.DeviceID & "'"
Ds = GetDS(SQL)
If Ds.Tables(0).Rows.Count <> 0 Then
Pb.Maximum = Ds.Tables(0).Rows.Count
' ci sono cose aggiunte
MainSQL = ""
For J = 0 To Ds.Tables(0).Columns.Count - 1
MainSQL = MainSQL & "," &
Ds.Tables(0).Columns(J).ColumnName
Next
If MainSQL <> "" Then MainSQL = Mid(MainSQL, 2)
MainSQL = "INSERT INTO INTERVENTI (" & MainSQL & ") VALUES
"
For I = 0 To Ds.Tables(0).Rows.Count - 1
SQL = ""
Ds.Tables(0).Rows(I)("DeviceID") = "0"
Ds.Tables(0).Rows(I)("FlagVariatoP" &
Parametri.DeviceID) = "0"
For J = 0 To Ds.Tables(0).Columns.Count - 1
SQL = SQL & ",'" & Ds.Tables(0).Rows(I)(J) & "'"
Next
If SQL <> "" Then SQL = Mid(SQL, 2)
SQL = MainSQL & " (" & SQL & ")"
Cmd.CommandText = SQL
Try
Cmd.ExecuteNonQuery()
SQL = "UPDATE INTERVENTI SET DeviceId='0' WHere
Codice='" & Ds.Tables(0).Rows(I)("Codice") & "'"
RunSQL(SQL)
Catch e As SqlClient.SqlException
ErrOut = SQLErrorDesktop(e)
End Try
Pb.Value = Pb.Value + 1
Next
End If
Pb.Minimum = 0
Pb.Value = 0
'Da PC a palmare
SQL = "Select * from INTERVENTI Where FlagVariatoP" &
Parametri.DeviceID & "='1'"
Dim Da As New SqlClient.SqlDataAdapter(SQL,
Parametri.StrCn_Master)
Da.Fill(Ds)
If Ds.Tables(0).Rows.Count <> 0 Then
' ci sono cose aggiunte
Pb.Maximum = Ds.Tables(0).Rows.Count
MainSQL = ""
For J = 0 To Ds.Tables(0).Columns.Count - 1
MainSQL = MainSQL & "," &
Ds.Tables(0).Columns(J).ColumnName
Next
If MainSQL <> "" Then MainSQL = Mid(MainSQL, 2)
MainSQL = "INSERT INTO INTERVENTI (" & MainSQL & ") VALUES
"
For I = 0 To Ds.Tables(0).Rows.Count - 1
SQL = "DELETE INTERVENTI WHere Codice='" &
Ds.Tables(0).Rows(I)("Codice") & "'"
RunSQL(SQL)
SQL = ""
Variati = Variati & ";" &
Ds.Tables(0).Rows(I)("Codice")
Ds.Tables(0).Rows(I)("DeviceID") = "0"
Ds.Tables(0).Rows(I)("FlagVariatoP" &
Parametri.DeviceID) = "0"
For J = 0 To Ds.Tables(0).Columns.Count - 1
If
Ds.Tables(0).Columns(J).DataType.FullName.ToString <> "System.String"
Then
SQL = SQL & "," &
Replace(Ds.Tables(0).Rows(I)(J).ToString, ",", ".") & ""
Else
SQL = SQL & ",'" & Ds.Tables(0).Rows(I)(J) &
"'"
End If
Next
If SQL <> "" Then SQL = Mid(SQL, 2)
SQL = MainSQL & " (" & SQL & ")"
RunSQL(SQL)
SQL = "UPDATE INTERVENTI SET FlagVariatoP" &
Parametri.DeviceID & "='0' WHere Codice='" &
Ds.Tables(0).Rows(I)("Codice") & "'"
Cmd.CommandText = SQL
Try
Cmd.ExecuteNonQuery()
Catch e As SqlClient.SqlException
ErrOut = SQLErrorDesktop(e)
End Try
Pb.Value = Pb.Value + 1
Next
End If
If Variati <> "" Then
' per gli interventi variati, recupero anche i materiali
Variati = Mid(Variati, 2)
Codici = Split(Variati, ";")
MainSQL = ""
Pb.Minimum = 0
Pb.Value = 0
Ds.Clear()
Ds.Dispose()
Pb.Maximum = Codici.Length
For K = 0 To Codici.Length - 1
Pb.Value = Pb.Value + 1
Ds.Clear()
Ds.Dispose()
Ds = Nothing
Da.Dispose()
Da = Nothing
SQL = "Select * from INTERVENTI_materiali Where
CodIntervento='" & Codici(K).Trim & "'"
Da = New SqlClient.SqlDataAdapter(SQL,
Parametri.StrCn_Master)
Ds = New System.Data.DataSet
Da.Fill(Ds)
If MainSQL = "" Then
For J = 0 To Ds.Tables(0).Columns.Count - 1
MainSQL = MainSQL & "," &
Ds.Tables(0).Columns(J).ColumnName
Next
If MainSQL <> "" Then MainSQL = Mid(MainSQL, 2)
MainSQL = "INSERT INTO INTERVENTI_materiali (" &
MainSQL & ") VALUES "
End If
SQL = "DELETE INTERVENTI_materiali Where
CodIntervento='" & Codici(K).Trim & "'"
RunSQL(SQL)
For I = 0 To Ds.Tables(0).Rows.Count - 1
SQL = ""
For J = 0 To Ds.Tables(0).Columns.Count - 1
If
Ds.Tables(0).Columns(J).DataType.FullName.ToString <> "System.String"
Then
SQL = SQL & "," &
Replace(Ds.Tables(0).Rows(I)(J).ToString, ",", ".") & ""
Else
SQL = SQL & ",'" & Ds.Tables(0).Rows(I)(J)
& "'"
End If
Next
If SQL <> "" Then SQL = Mid(SQL, 2)
SQL = MainSQL & " (" & SQL & ")"
RunSQL(SQL)
Next I
Ds.Clear()
Ds.Dispose()
Next
End If
Ds.Dispose()
Ds = Nothing
Da.Dispose()
Da = Nothing
End Sub
Public Sub AggiornaPalmareANAGRAFICA(ByRef C As
SqlClient.SqlConnection, ByRef Pb As ProgressBar)
Dim SQL As String
Dim MainSQL As String
Dim Ds As DataSet
Dim I As Integer
Dim J As Integer
Dim Cmd As New SqlClient.SqlCommand
Dim ErrOut As String
ErrOut = ""
Cmd.Connection = C
Pb.Minimum = 0
Pb.Value = 0
'Da Palmare a PC
SQL = "Select * from ANAGRAFICA WHERE DeviceID='" &
Parametri.DeviceID & "'"
Ds = GetDS(SQL)
If Ds.Tables(0).Rows.Count <> 0 Then
Pb.Maximum = Ds.Tables(0).Rows.Count
' ci sono cose aggiunte
MainSQL = ""
For J = 0 To Ds.Tables(0).Columns.Count - 1
MainSQL = MainSQL & "," &
Ds.Tables(0).Columns(J).ColumnName
Next
If MainSQL <> "" Then MainSQL = Mid(MainSQL, 2)
MainSQL = "INSERT INTO ANAGRAFICA (" & MainSQL & ") VALUES
"
For I = 0 To Ds.Tables(0).Rows.Count - 1
SQL = ""
Ds.Tables(0).Rows(I)("DeviceID") = "0"
Ds.Tables(0).Rows(I)("FlagVariatoP" &
Parametri.DeviceID) = "0"
For J = 0 To Ds.Tables(0).Columns.Count - 1
SQL = SQL & ",'" & Ds.Tables(0).Rows(I)(J) & "'"
Next
If SQL <> "" Then SQL = Mid(SQL, 2)
SQL = MainSQL & " (" & SQL & ")"
Cmd.CommandText = SQL
Try
Cmd.ExecuteNonQuery()
SQL = "UPDATE Anagrafica SET DeviceId='0' WHere
Codice='" & Ds.Tables(0).Rows(I)("Codice") & "'"
RunSQL(SQL)
Catch e As SqlClient.SqlException
ErrOut = SQLErrorDesktop(e)
End Try
Pb.Value = Pb.Value + 1
Next
End If
Pb.Minimum = 0
Pb.Value = 0
'Da PC a palmare
SQL = "Select * from Anagrafica Where FlagVariatoP" &
Parametri.DeviceID & "='1'"
Dim Da As New SqlClient.SqlDataAdapter(SQL,
Parametri.StrCn_Master)
Da.Fill(Ds)
If Ds.Tables(0).Rows.Count <> 0 Then
' ci sono cose aggiunte
Pb.Maximum = Ds.Tables(0).Rows.Count
MainSQL = ""
For J = 0 To Ds.Tables(0).Columns.Count - 1
MainSQL = MainSQL & "," &
Ds.Tables(0).Columns(J).ColumnName
Next
If MainSQL <> "" Then MainSQL = Mid(MainSQL, 2)
MainSQL = "INSERT INTO ANAGRAFICA (" & MainSQL & ") VALUES
"
For I = 0 To Ds.Tables(0).Rows.Count - 1
SQL = "DELETE Anagrafica WHere Codice='" &
Ds.Tables(0).Rows(I)("Codice") & "'"
RunSQL(SQL)
SQL = ""
Ds.Tables(0).Rows(I)("DeviceID") = "0"
Ds.Tables(0).Rows(I)("FlagVariatoP" &
Parametri.DeviceID) = "0"
For J = 0 To Ds.Tables(0).Columns.Count - 1
SQL = SQL & ",'" & Ds.Tables(0).Rows(I)(J) & "'"
Next
If SQL <> "" Then SQL = Mid(SQL, 2)
SQL = MainSQL & " (" & SQL & ")"
RunSQL(SQL)
SQL = "UPDATE Anagrafica SET FlagVariatoP" &
Parametri.DeviceID & "='0' WHere Codice='" &
Ds.Tables(0).Rows(I)("Codice") & "'"
Cmd.CommandText = SQL
Try
Cmd.ExecuteNonQuery()
Catch e As SqlClient.SqlException
ErrOut = SQLErrorDesktop(e)
End Try
Pb.Value = Pb.Value + 1
Next
End If
'da PC a PALMARE chiavi
SQL = "Delete Anagrafica_Chiavi"
RunSQL(SQL)
Da.Dispose()
Pb.Minimum = 0
Pb.Value = 0
SQL = "Select * from Anagrafica_Chiavi"
Da = New SqlClient.SqlDataAdapter(SQL, Parametri.StrCn_Master)
Ds.Clear()
Ds.Dispose()
Da.Fill(Ds)
Pb.Maximum = Ds.Tables(0).Rows.Count
MainSQL = "INSERT INTO Anagrafica_Chiavi
(CodiceAnagrafica,Chiave) Values "
SQL = ""
For I = 0 To Ds.Tables(0).Rows.Count - 1
SQL = ""
SQL = "'" & Ds.Tables(0).Rows(I)("CodiceAnagrafica") &
"','" & Ds.Tables(0).Rows(I)("Chiave") & "'"
Pb.Value = I
SQL = MainSQL & "(" & SQL & ")"
RunSQL(SQL)
Next
Ds.Dispose()
Ds = Nothing
Da.Dispose()
Da = Nothing
Cmd.Dispose()
End Sub
Public Sub AggiornaPalmareARTICOLI(ByRef C As
SqlClient.SqlConnection, ByRef Pb As ProgressBar)
Dim SQL As String
Dim MainSQL As String
Dim Ds As DataSet
Dim I As Integer
Dim J As Integer
Dim Cmd As New SqlClient.SqlCommand
Dim ErrOut As String
ErrOut = ""
Cmd.Connection = C
Pb.Minimum = 0
Pb.Value = 0
Pb.Minimum = 0
Pb.Value = 0
Ds = New DataSet
'Da PC a palmare
SQL = "Select * from Articoli Where FlagVariatoP" &
Parametri.DeviceID & "='1'"
Dim Da As New SqlClient.SqlDataAdapter(SQL,
Parametri.StrCn_Master)
Da.Fill(Ds)
If Ds.Tables(0).Rows.Count <> 0 Then
' ci sono cose aggiunte
Pb.Maximum = Ds.Tables(0).Rows.Count
MainSQL = ""
For J = 0 To Ds.Tables(0).Columns.Count - 1
MainSQL = MainSQL & "," &
Ds.Tables(0).Columns(J).ColumnName
Next
If MainSQL <> "" Then MainSQL = Mid(MainSQL, 2)
MainSQL = "INSERT INTO Articoli (" & MainSQL & ") VALUES "
For I = 0 To Ds.Tables(0).Rows.Count - 1
SQL = "DELETE Articoli WHere Codice='" &
Ds.Tables(0).Rows(I)("Codice") & "'"
RunSQL(SQL)
SQL = ""
Ds.Tables(0).Rows(I)("DeviceID") = "0"
Ds.Tables(0).Rows(I)("FlagVariatoP" &
Parametri.DeviceID) = "0"
For J = 0 To Ds.Tables(0).Columns.Count - 1
SQL = SQL & ",'" & Ds.Tables(0).Rows(I)(J) & "'"
Next
If SQL <> "" Then SQL = Mid(SQL, 2)
SQL = MainSQL & " (" & SQL & ")"
RunSQL(SQL)
SQL = "UPDATE Articoli SET FlagVariatoP" &
Parametri.DeviceID & "='0' WHere Codice='" &
Ds.Tables(0).Rows(I)("Codice") & "'"
Cmd.CommandText = SQL
Try
Cmd.ExecuteNonQuery()
Catch e As SqlClient.SqlException
ErrOut = SQLErrorDesktop(e)
End Try
Pb.Value = Pb.Value + 1
Next
End If
Ds.Dispose()
Ds = Nothing
Da.Dispose()
Da = Nothing
Cmd.Dispose()
End Sub
Public Sub AggiornaPalmareTabelle(ByRef C As
SqlClient.SqlConnection, ByRef Pb As ProgressBar)
Dim SQL As String
Dim MainSQL As String
Dim Ds As DataSet
Dim I As Integer
Dim Cmd As New SqlClient.SqlCommand
Dim ErrOut As String
ErrOut = ""
Ds = Nothing
'da PC a PALMARE Utenti
SQL = "Delete Utenti"
RunSQL(SQL)
Pb.Minimum = 0
Pb.Value = 0
SQL = "Select * from Utenti"
Dim Da As New SqlClient.SqlDataAdapter(SQL,
Parametri.StrCn_Master)
Ds = New System.Data.DataSet
Da.Fill(Ds)
Pb.Maximum = Ds.Tables(0).Rows.Count
MainSQL = "INSERT INTO UTENTI
(Codice,Descrizione,Password,Flagadmin) Values "
SQL = ""
For I = 0 To Ds.Tables(0).Rows.Count - 1
SQL = ""
SQL = "'" & Ds.Tables(0).Rows(I)("Codice") & "','" &
Ds.Tables(0).Rows(I)("Descrizione") & "','" &
Ds.Tables(0).Rows(I)("Password") & "','" &
Ds.Tables(0).Rows(I)("Flagadmin") & "'"
Pb.Value = I
SQL = MainSQL & "(" & SQL & ")"
RunSQL(SQL)
Next
Da.Dispose()
Da = Nothing
Ds.Clear()
Ds.Dispose()
Ds = Nothing
'da PC a PALMARE Interventi_Tipo
SQL = "Delete Interventi_Tipo"
RunSQL(SQL)
Pb.Minimum = 0
Pb.Value = 0
SQL = "Select * from Interventi_Tipo"
Da = New SqlClient.SqlDataAdapter(SQL, Parametri.StrCn_Master)
Ds = New System.Data.DataSet
Da.Fill(Ds)
Pb.Maximum = Ds.Tables(0).Rows.Count
MainSQL = "INSERT INTO Interventi_Tipo
(Codice,Descrizione,Predefinito) Values "
SQL = ""
For I = 0 To Ds.Tables(0).Rows.Count - 1
SQL = ""
SQL = "'" & Ds.Tables(0).Rows(I)("Codice") & "','" &
Ds.Tables(0).Rows(I)("Descrizione") & "','" &
Ds.Tables(0).Rows(I)("Predefinito") & "'"
Pb.Value = I
SQL = MainSQL & "(" & SQL & ")"
RunSQL(SQL)
Next
Ds.Clear()
Ds.Dispose()
Da.Dispose()
Ds = Nothing
Da = Nothing
Cmd.Dispose()
End Sub
Public Sub PopolaLW(ByVal SQL As String, ByRef Lw As
System.Windows.Forms.ListView, ByVal NomiCol As String, ByVal LargCol
As String)
Dim Ds As DataSet
Dim I As Integer
Dim J As Integer
Dim N As String
Dim W As Integer
Dim Li As System.Windows.Forms.ListViewItem
Ds = GetDS(SQL)
Lw.Columns.Clear()
Lw.Items.Clear()
Lw.BeginUpdate()
If Ds.Tables(0).Rows.Count <> 0 Then
For J = 0 To Ds.Tables(0).Columns.Count - 1
'MainSQL = MainSQL & "," &
Ds.Tables(0).Columns(J).ColumnName
If NomiCol <> "" Then
N = NomiCol.Split(";")(J)
Else
N = ""
End If
If LargCol <> "" Then
W = LargCol.Split(";")(J)
Else
W = 100
End If
Lw.Columns.Add(N, W, HorizontalAlignment.Left)
Next
End If
For I = 0 To Ds.Tables(0).Rows.Count - 1
Li = New System.Windows.Forms.ListViewItem
For J = 0 To Ds.Tables(0).Columns.Count - 1
If J = 0 Then
Li.Text = Ds.Tables(0).Rows(I)(J)
Else
Li.SubItems.Add(Ds.Tables(0).Rows(I)(J).ToString)
End If
Next
Lw.Items.Add(Li)
Next
Lw.EndUpdate()
End Sub
Public Sub PopolaLWPAG(ByRef Dt As DataTable, ByRef Lw As
System.Windows.Forms.ListView, ByVal NomiCol As String, ByVal LargCol
As String)
Dim I As Integer
Dim J As Integer
Dim N As String
Dim W As Integer
Dim Li As System.Windows.Forms.ListViewItem
Lw.Columns.Clear()
Lw.Items.Clear()
Lw.BeginUpdate()
If Dt.Rows.Count <> 0 Then
For J = 0 To Dt.Columns.Count - 1
'MainSQL = MainSQL & "," &
Ds.Tables(0).Columns(J).ColumnName
If NomiCol <> "" Then
N = NomiCol.Split(";")(J)
Else
N = ""
End If
If LargCol <> "" Then
W = LargCol.Split(";")(J)
Else
W = 100
End If
Lw.Columns.Add(N, W, HorizontalAlignment.Left)
Next
End If
For I = 0 To Dt.Rows.Count - 1
Li = New System.Windows.Forms.ListViewItem
For J = 0 To Dt.Columns.Count - 1
If J = 0 Then
Li.Text = Dt.Rows(I)(J)
Else
Li.SubItems.Add(Dt.Rows(I)(J).ToString)
End If
Next
Lw.Items.Add(Li)
Next
Lw.EndUpdate()
End Sub
Public Sub ApriStatSogg()
Cursor.Current = Cursors.WaitCursor
If Not IsNothing(Parametri.FrmStatSogg_I) Then
Parametri.FrmStatSogg_I.Dispose()
End If
Parametri.FrmStatSogg_I = New FrmStatSogg
Parametri.FrmStatSogg_I.Show()
Cursor.Current = Cursors.Default
End Sub
Public Sub ApriAnagrafica()
Cursor.Current = Cursors.WaitCursor
If Not IsNothing(Parametri.FrmAnagraficaDesktop_I) Then
Parametri.FrmAnagraficaDesktop_I.Dispose()
End If
Parametri.FrmAnagraficaDesktop_I = New FrmAnagraficaDesktop
Parametri.FrmAnagraficaDesktop_I.Show()
Cursor.Current = Cursors.Default
End Sub
Public Sub ApriAggiornaPalmare()
Cursor.Current = Cursors.WaitCursor
If Not IsNothing(Parametri.FrmAggiornaPalmare_I) Then
Parametri.FrmAggiornaPalmare_I.Dispose()
End If
Parametri.FrmAggiornaPalmare_I = New FrmAggiornaPalmare
Parametri.FrmAggiornaPalmare_I.Show()
Cursor.Current = Cursors.Default
End Sub
Public Sub ApriAnagraficaArticoli()
Cursor.Current = Cursors.WaitCursor
If Not IsNothing(Parametri.FrmAnaArticoli_I) Then
Parametri.FrmAnaArticoli_I.Dispose()
End If
Parametri.FrmAnaArticoli_I = New FrmAnagraficaArticoli
Parametri.FrmAnaArticoli_I.Show()
Cursor.Current = Cursors.Default
End Sub
Public Sub ApriRicFurgone()
If Not IsNothing(Parametri.FrmRicFurgone_I) Then
Parametri.FrmRicFurgone_I.Dispose()
End If
Parametri.FrmRicFurgone_I = New FrmRicFurgone
Parametri.FrmRicFurgone_I.Show()
End Sub
Public Sub ApriFurgone()
If Not IsNothing(Parametri.FrmFurgone_I) Then
Parametri.FrmFurgone_I.Dispose()
End If
Parametri.FrmFurgone_I = New FrmFurgone
Parametri.FrmFurgone_I.Show()
End Sub
Public Sub ApriTabelle()
If Not IsNothing(Parametri.FrmTabelle_I) Then
Parametri.FrmTabelle_I.Dispose()
End If
Parametri.FrmTabelle_I = New FrmTabelle
Parametri.FrmTabelle_I.Show()
End Sub
Public Sub ApriIntervento()
Cursor.Current = Cursors.WaitCursor
If Not IsNothing(Parametri.FrmIntervento_I) Then
Parametri.FrmIntervento_I.Dispose()
End If
Parametri.FrmIntervento_I = New FrmIntervento
Parametri.FrmIntervento_I.Show()
Cursor.Current = Cursors.Default
End Sub
Public Sub ApriRicInterventi()
Cursor.Current = Cursors.WaitCursor
If Not IsNothing(Parametri.FrmRicInterventi_I) Then
Parametri.FrmRicInterventi_I.Dispose()
End If
Parametri.FrmRicInterventi_I = New FrmRicInterventi
Parametri.FrmRicInterventi_I.Show()
Cursor.Current = Cursors.Default
End Sub
Public Sub ApriAnagraficaArticoliSUID(ByVal CheId As String)
Cursor.Current = Cursors.WaitCursor
ApriAnagraficaArticoli()
Parametri.FrmAnaArticoli_I.LoadArticolo(CheId)
Parametri.FrmAnaArticoli_I.Focus()
Parametri.FrmAnaArticoli_I.Activate()
Cursor.Current = Cursors.Default
End Sub
Public Sub ApriAnagraficaSUID(ByVal CheId As String)
Cursor.Current = Cursors.WaitCursor
ApriAnagrafica()
Parametri.FrmAnagraficaDesktop_I.LoadAnagrafica(CheId)
Parametri.FrmAnagraficaDesktop_I.Focus()
Parametri.FrmAnagraficaDesktop_I.Activate()
Cursor.Current = Cursors.Default
End Sub
Public Sub ApriInterventoSUID(ByVal CheId As String)
Cursor.Current = Cursors.WaitCursor
ApriIntervento()
Parametri.FrmIntervento_I.LoadIntervento(CheId)
Cursor.Current = Cursors.Default
End Sub
Public Sub ApriAnagraficaRisultati()
Cursor.Current = Cursors.WaitCursor
If Not IsNothing(Parametri.FrmAnagraficaRicRisultati_I) Then
Parametri.FrmAnagraficaRicRisultati_I.Dispose()
End If
Parametri.FrmAnagraficaRicRisultati_I = New
FrmAnagraficaRicRisultati
Parametri.FrmAnagraficaRicRisultati_I.Show()
Cursor.Current = Cursors.Default
End Sub
Public Sub Close_All()
End Sub
Public Function GetComboCodice(ByRef C As
System.Windows.Forms.ComboBox, ByVal NomeCampo As String)
Try
Dim row As DataRowView = CType(C.Items(C.SelectedIndex),
DataRowView)
GetComboCodice = row(NomeCampo).ToString
Catch
GetComboCodice = ""
End Try
End Function
Public Sub SelCombo(ByRef Cb As System.Windows.Forms.ComboBox,
ByVal Chi As String)
Dim NomeCampo As String
Dim row As DataRowView
Dim I As Long
NomeCampo = Cb.ValueMember
For I = 0 To Cb.Items.Count - 1
row = CType(Cb.Items(I), DataRowView)
If Chi = row(NomeCampo).ToString Then
Cb.SelectedItem = Cb.Items(I)
Exit For
End If
Next
End Sub
Public Function GetInterventoDefault() As String
GetInterventoDefault = dLookup("Codice", "Interventi_Tipo",
"Predefinito='1'", "").ToString
End Function
Public Sub CaricaComboTipoIntervento(ByRef Cb As
System.Windows.Forms.ComboBox, ByVal Preselezione As String)
Dim Ds As DataSet
'Dim row As DataRowView =
CType(cmbBox.Items(cmbBox.SelectedIndex), DataRowView)
'Label4.Text = row("id_cliente")
Ds = GetDS("Select * from Interventi_Tipo ORDER BY
Descrizione")
Cb.Items.Clear()
Cb.DataSource = Ds.Tables(0)
'For I = 0 To Ds.Tables(0).Rows.Count - 1
' Cb.Items.Add()
'Next
Cb.DisplayMember = "Descrizione"
Cb.ValueMember = "Codice"
If Preselezione <> "" Then
'Cb.SelectedItem = Cb.Items(Cb.Items.IndexOf(Preselezione))
SelCombo(Cb, Preselezione)
End If
End Sub
Public Sub CaricaComboUtenti(ByRef Cb As
System.Windows.Forms.ComboBox, ByVal Preselezione As String)
Dim Ds As DataSet
'Dim row As DataRowView =
CType(cmbBox.Items(cmbBox.SelectedIndex), DataRowView)
'Label4.Text = row("id_cliente")
Ds = GetDS("Select * from Utenti")
Cb.Items.Clear()
Cb.DataSource = Ds.Tables(0)
'For I = 0 To Ds.Tables(0).Rows.Count - 1
' Cb.Items.Add()
'Next
Cb.DisplayMember = "Descrizione"
Cb.ValueMember = "Codice"
If Preselezione <> "" Then
'Cb.SelectedItem = Cb.Items(Cb.Items.IndexOf(Preselezione))
SelCombo(Cb, Preselezione)
End If
End Sub
Public Function ValidaLogin(ByVal Utente As String, ByVal Password
As String) As Boolean
Dim SQL As String
Dim Ds As DataSet
Dim Pdb As String
Dim Ok As Boolean
Parametri.UtAdmin = False
Utente = Utente.ToUpper
Ok = False
If Utente <> "ADMIN" Then
SQL = "Select * from utenti where codice='" &
Replace(Utente, "'", "") & "'"
Ds = GetDS(SQL)
If Ds.Tables(0).Rows.Count > 0 Then
Pdb = Ds.Tables(0).Rows(0)("Password").ToString
Ok = (Pdb = Password)
Parametri.UtAdmin =
(Ds.Tables(0).Rows(0)("FlagAdmin").ToString = "1")
End If
Ds.Clear()
Ds.Dispose()
Else
Pdb = "admin" & Now.ToString("ddMMyy")
Ok = (Pdb = Password)
Parametri.UtAdmin = Ok
End If
ValidaLogin = Ok
End Function
Public Function RicArt(ByRef OutCod As String, ByRef OutDes As
String) As FrmRicAna.Status
Dim F As New FrmRicAna
F.ShowDialog()
OutCod = F.Codice
OutDes = F.Descrizione
RicArt = F.Stato
F.Dispose()
End Function
Public Function NewAddMat(ByRef OutDes As String, ByRef OutQta As
String, ByRef OutCosto As String) As AddMatDescr.Status
Dim F As New AddMatDescr
F.ShowDialog()
OutDes = F.Descrizione
OutCosto = F.Costo
OutQta = F.Qta
NewAddMat = F.Stato
F.Dispose()
End Function
Public Function RicSogg(ByRef OutCod As String, ByRef OutDes As
String) As FrmRicSog.Status
Dim F As New FrmRicSog
F.ShowDialog()
OutCod = F.Codice
OutDes = F.Descrizione
RicSogg = F.Stato
F.Dispose()
End Function
Public Function DesAnagrafica(ByVal CheCod As String) As String
DesAnagrafica = dLookup("RagSociale", "Anagrafica", "Codice='"
& CheCod & "'", "").ToString
End Function
Public Sub ConvalidaInputData(ByVal DataIn As String, ByRef OK As
Boolean, ByRef DataOut As String)
Dim D As Date
OK = False
DataOut = ""
If DataIn <> "" Then
Try
D = DateTime.Parse(DataIn)
DataOut = Format(D, "dd/MM/yyyy")
OK = True
Catch
OK = False
DataOut = ""
End Try
End If
End Sub
Public Sub ConvalidaInputSinglePositivo(ByVal SingleIn As String,
ByRef OK As Boolean, ByRef SingleOut As String)
Dim S As Single
OK = False
SingleOut = ""
If SingleIn <> "" Then
Try
S = Single.Parse(SingleIn)
If S >= 0 Then
SingleOut = Format(S, "##,##0.00")
OK = True
Else
OK = False
SingleOut = ""
End If
Catch
OK = False
SingleOut = ""
End Try
End If
End Sub
Public Sub InputNumerico(ByVal Tb As System.Windows.Forms.TextBox,
ByVal e As System.Windows.Forms.KeyPressEventArgs)
If e.KeyChar = "." Then
e.Handled = True
Tb.Text = Tb.Text & ","
Tb.SelectionStart = Len(Tb.Text)
End If
End Sub
Public Sub OutLW(ByVal Lw As System.Windows.Forms.ListView, ByVal
NomeFile As String, ByVal TipoOut As String, ByVal Apri As Boolean)
Dim O As String
Dim R As String
Dim I As Long
O = ""
CancellaFile(NomeFile)
Dim Li As System.Windows.Forms.ListViewItem
For Each Li In Lw.Items
R = ""
R = Li.Text
For I = 1 To Li.SubItems.Count - 1
R = R & "," & Replace(Replace(Li.SubItems(I).Text,
vbCrLf, " "), ",", ".")
Next
O = O & vbCrLf & R
Next
If O <> "" Then O = Mid(O, 3)
ScriviFile(O, NomeFile)
If Apri Then
ApriFileProg(NomeFile)
End If
End Sub
Public Sub OutHTML(ByVal SQL As String, ByVal Modello As String,
ByRef OutFile As String, ByVal Apro As Boolean, ByVal SottoRep As
Boolean)
OutFile = ""
Dim StrModello As String
Dim PStart As Long
Dim PEnd As Long
Dim SRepl As String
Dim NewBody As String
Dim NewPezzo As String
Dim Dr As System.Data.DataRow
Dim Dt As System.Data.DataTable
Dim Ds As System.Data.DataSet
Dim SrBody As String
Dim SrSQL As String
Dim SrNome As String
Dim CeSottoReport As Boolean
SrSQL = ""
SrNome = ""
CeSottoReport = False
Dim MaxCol As String
Dim I As Integer
If Not System.IO.File.Exists(Modello) Then
MsgBox("File modello stampa " & Modello & " non trovato !",
MsgBoxStyle.Exclamation, Parametri.AppName)
Exit Sub
End If
Ds = GetDS(SQL)
Dt = Ds.Tables(0)
NewBody = ""
NewPezzo = ""
MaxCol = 0
StrModello = ReadALLFile(Modello)
PStart = InStr(1, StrModello, "<!-- INCLUDE START -->")
PEnd = InStr(1, StrModello, "<!-- INCLUDE END -->")
If PStart <> 0 Then
'cè un sottoreport !
CeSottoReport = True
Dim SRep As String
SRep = Mid(StrModello, PStart + Len("<!-- INCLUDE START
-->"), PEnd - PStart)
SRep = Replace(SRep, "<!-- INCLUDE START -->", "")
SRep = Replace(SRep, "<!-- INCLUDE END -->", "")
SrSQL = SRep.Split("|")(0).ToString
SrNome = SRep.Split("|")(1).ToString
SrNome = SrNome.Replace(vbCrLf, "")
End If
PStart = 0
PEnd = 0
PStart = InStr(1, StrModello, "<!-- VB CODE START -->")
PEnd = InStr(1, StrModello, "<!-- VB CODE END -->")
SRepl = Mid(StrModello, PStart + Len("<!-- VB CODE START -->"),
PEnd - PStart)
SRepl = Replace(SRepl, "<!-- VB CODE START -->", "")
SRepl = Replace(SRepl, "<!-- VB CODE END -->", "")
MaxCol = Dt.Columns.Count
For Each Dr In Dt.Rows
NewPezzo = SRepl
For I = 0 To MaxCol - 1
NewPezzo = Replace(NewPezzo, "<%" &
Dt.Columns(I).ColumnName.ToUpper & "%>", Trim(Nz(Dr(I).ToString,
" ")))
If CeSottoReport Then
SrSQL = Replace(SrSQL, "<%" &
Dt.Columns(I).ColumnName.ToUpper & "%>", Trim(Nz(Dr(I).ToString, "")))
End If
Next
NewBody = vbCrLf & NewBody & NewPezzo
Next
Ds.Clear()
Ds.Dispose()
Ds = Nothing
Dr = Nothing
Dt.Clear()
Dt.Dispose()
Dt = Nothing
NewBody = Mid(StrModello, 1, PStart - 1) & NewBody &
Mid(StrModello, PEnd)
If CeSottoReport Then
SrBody = ""
SrNome = System.IO.Path.GetDirectoryName(Modello) & "\" &
SrNome
OutHTML(SrSQL, SrNome, SrBody, True, True)
PStart = InStr(1, NewBody, "<!-- INCLUDE START -->")
PEnd = InStr(1, NewBody, "<!-- INCLUDE END -->")
If PStart <> 0 Then
NewBody = Mid(NewBody, 1, PStart - 1) & SrBody &
Mid(NewBody, PEnd + Len("<!-- INCLUDE END -->"))
End If
End If
If SottoRep Then
OutFile = NewBody
Else
OutFile = System.IO.Path.GetTempFileName
CancellaFile(OutFile)
OutFile = OutFile.ToUpper
OutFile = Replace(OutFile, ".TMP", "_CI_.HTML")
ScriviFile(NewBody, OutFile)
If Apro Then
ApriFileProg(OutFile)
'CancellaFile(OutFile)
End If
End If
End Sub
End Module
