translating a vb -> PHP if possible
Posted: Mon Feb 16, 2004 5:41 pm
Well alot of info is not needed for those who know vb.
However a little bit of information might help
basicly what this part does is reading a text file and puts it into a database
( SQL windows )
if possible have it translated to php
if possible have it update 2 databases ( mysql and a SQL db )
this script should be able to run on a linux machine..
Now about the money / or any other thing.. , i myself dont make that much money. So i guess i am not able to pay anything.
Here is the VB code
However a little bit of information might help
basicly what this part does is reading a text file and puts it into a database
( SQL windows )
if possible have it translated to php
if possible have it update 2 databases ( mysql and a SQL db )
this script should be able to run on a linux machine..
Now about the money / or any other thing.. , i myself dont make that much money. So i guess i am not able to pay anything.
Here is the VB code
Code: Select all
Private Sub cmdImportar_Click()
On Error GoTo errImportar
Dim fso, f, totalArchivo
Dim ruta As String
Dim linea As Integer
Dim TAMANO As Long
Dim pos As Long
Dim enc As Long
Dim dlinea
Dim k As Integer
Dim J As Integer
Dim h As Integer
Dim guia_madre As String
Dim tipo As String
Dim nombre_remitente As String
Dim nombre_destinatario As String
Dim ciudad_origen As String
Dim ciudad_destino As String
Dim descripcion As String
Dim peso_declarado As Double
Dim valor_declarado As Double
Dim Nempresa
Dim piezas_guia As Integer
contador = 0
SNM = 0
If Check1.Value = 1 Then
SNM = 1
If InStr(1, TxtGuiaAerea, "NM", 0) = 0 Then
madre = TxtGuiaAerea + "NM"
Else
madre = TxtGuiaAerea
End If
Else
madre = TxtGuiaAerea
End If
If Trim(TxtGuiaAerea) = "" Or dblempresa.ListIndex = -1 Or Trim(TxtFile) = "" Then
MsgBox "Debe Escoger Todos Los Datos Para Importar.", vbInformation
If Trim(TxtGuiaAerea) = "" Then
TxtGuiaAerea.SetFocus
ElseIf dblempresa.ListIndex = -1 Then
dblempresa.SetFocus
End If
Exit Sub
End If
ruta = TxtFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.opentextfile(ruta, 1)
linea = Len(f.readline)
f.Close
Set f = fso.opentextfile(ruta, 1)
While f.atendofline = False
dlinea = f.readline
If Len(Trim(dlinea)) < 5 Then
GoTo 7
End If
If Err.Number = 62 Then
GoTo 7
End If
k = k + 1
Wend
7
If k <= 0 Then
MsgBox "No Tiene Datos El Archivo De " & cboEmpresa.Text, vbInformation
Exit Sub
End If
guias_existentes = 0
guias_malas = 0
Set inventario = Workspaces(0).OpenDatabase("p:\bases\inventario.MDB", False, False, ";pwd=yo;")
Set MANIF = inventario.OpenRecordset("select id from empresa where empresa='" & dblempresa.Text & "'")
If MANIF.EOF = False Then
Nempresa = MANIF(0)
End If
Set MANIF = inventario.OpenRecordset("manifiesto")
Set temporal = Workspaces(0).OpenDatabase("c:\bases\temporal.MDB")
temporal.Execute "delete from malmanifestados"
Set MALMANIF = temporal.OpenRecordset("MalManifestados", dbOpenTable)
f.Close
Set f = fso.opentextfile(ruta, 1)
For i = 1 To k
dlinea = f.readline
If linea <= 350 Then
Set tempo = inventario.OpenRecordset("select 1 from manifiesto where guia_madre='" & TxtGuiaAerea & "' and guia_courier='" & UCase(Mid(dlinea, 41, 40)) & "'")
Else
Set tempo = inventario.OpenRecordset("select 1 from manifiesto where guia_madre='" & TxtGuiaAerea & "' and guia_courier='" & UCase(Mid(dlinea, 1, 40)) & "'")
End If
If tempo.EOF = False Then
guias_existentes = guias_existentes + 1
End If
Next i
Set f = fso.opentextfile(ruta, 1)
For i = 1 To k
dlinea = f.readline
If linea <= 350 Then
If IsNumeric(Mid(dlinea, 211, 10)) = False Or IsNumeric(Mid(dlinea, 221, 10)) = False Or UCase(Mid(dlinea, 161, 40)) = "" Or IsNumeric(Mid(dlinea, 231, 10)) = False Then
guias_malas = guias_malas + 1
MALMANIF.AddNew
MALMANIF("Guia_Madre") = madre
MALMANIF("Guia_Courier") = Mid$(dlinea, 41, 40)
MALMANIF("tipo_paquete") = Mid$(dlinea, 321, 1)
MALMANIF("Peso_Declarado") = Mid$(dlinea, 211, 10)
MALMANIF("Valor_Declarado") = Mid$(dlinea, 221, 10)
MALMANIF("Descripcion_Declarada") = Mid$(dlinea, 161, 40)
MALMANIF("codigo_empresa") = Nempresa
MALMANIF.Update
End If
Else
If IsNumeric(Mid(dlinea, 352, 5)) = False Or IsNumeric(Mid(dlinea, 292, 8)) = False Or UCase(Mid(dlinea, 300, 40)) = "" Or IsNumeric(Mid(dlinea, 342, 5)) = False Then
guias_malas = guias_malas + 1
MALMANIF.AddNew
MALMANIF("Guia_Madre") = madre
MALMANIF("Guia_Courier") = Mid$(dlinea, 1, 40)
MALMANIF("tipo_paquete") = Mid$(dlinea, 41, 1)
MALMANIF("Peso_Declarado") = Mid$(dlinea, 352, 5)
MALMANIF("Valor_Declarado") = Mid$(dlinea, 292, 8)
MALMANIF("Descripcion_Declarada") = Mid$(dlinea, 300, 40)
MALMANIF("codigo_empresa") = Nempresa
MALMANIF.Update
End If
End If
Next i
If guias_existentes <> k And guias_malas = 0 Then
ProgressBar1.Visible = True
ProgressBar1.Value = ProgressBar1.Min
ProgressBar1.Max = k + guias_existentes
Set f = fso.opentextfile(ruta, 1)
For i = 1 To k
pos = 1
enc = 1
dlinea = f.readline
For J = 1 To Len(dlinea)
pos = InStr(enc, dlinea, Chr(39), 1)
If pos <> 0 Then
Mid(dlinea, pos, 1) = Space(1)
enc = pos + 1
J = enc
End If
Next J
If linea <= 350 Then 'FORMATO THEMICROSERV
Set tempo = inventario.OpenRecordset("select 1 from manifiesto where guia_madre='" & TxtGuiaAerea & "' and guia_courier='" & UCase(Mid(dlinea, 41, 40)) & "'")
guia_madre = UCase(TxtGuiaAerea)
guia_courier = UCase(Mid(dlinea, 41, 40))
tipo = UCase(Mid(dlinea, 321, 1))
nombre_remitente = UCase(Mid(dlinea, 81, 40))
ciudad_origen = UCase(Mid(dlinea, 241, 40))
nombre_destinatario = UCase(Mid(dlinea, 121, 40))
ciudad_destino = UCase(Mid(dlinea, 281, 40))
descripcion = UCase(Mid(dlinea, 161, 40))
peso_declarado = Mid(dlinea, 211, 10)
valor_declarado = Mid(dlinea, 221, 10)
piezas_guia = Mid(dlinea, 231, 10)
Else 'FORMATO SABOTAKI
Set tempo = inventario.OpenRecordset("select 1 from manifiesto where guia_madre='" & TxtGuiaAerea & "' and guia_courier='" & UCase(Mid(dlinea, 1, 40)) & "'")
guia_madre = UCase(TxtGuiaAerea)
guia_courier = UCase(Mid(dlinea, 1, 40))
tipo = UCase(Mid(dlinea, 41, 1))
nombre_remitente = UCase(Mid(dlinea, 42, 40))
ciudad_origen = UCase(Mid(dlinea, 137, 15))
nombre_destinatario = UCase(Mid(dlinea, 167, 15))
ciudad_destino = UCase(Mid(dlinea, 262, 15))
descripcion = UCase(Mid(dlinea, 300, 40))
peso_declarado = Mid(dlinea, 352, 5)
valor_declarado = Mid(dlinea, 292, 8)
piezas_guia = Mid(dlinea, 342, 5)
End If
If SNM = 1 Then
t = Len(madre)
Set Nomanif = inventario.OpenRecordset("select guia_madre from nomanifiestos where guia_courier='" & guia_courier & "'")
If Nomanif.EOF = False Then
While Nomanif.EOF = False
If Mid(Trim(Nomanif(0)), 1, t) = Mid(madre, 1, t - 2) Then
inventario.Execute "delete from nomanifiestos where guia_madre='" & Nomanif(0) & "' and guia_courier='" & guia_courier & "'"
End If
Nomanif.MoveNext
Wend
End If
End If
If tempo.EOF = True Then
MANIF.AddNew
MANIF("guia_madre") = UCase(TxtGuiaAerea)
MANIF("guia_courier") = guia_courier
MANIF("Nombre_Remitente") = nombre_remitente
MANIF("Nombre_Destinatario") = nombre_destinatario
MANIF("Descripcion_Declarada") = descripcion
MANIF("Fecha_Manifiesto") = Date
MANIF("Peso_Declarado") = peso_declarado
MANIF("Valor_Declarado") = valor_declarado
If IsNumeric(piezas_guia) = True Then
MANIF("piezas_guia") = piezas_guia
Else
MANIF("piezas_guia") = 1
End If
MANIF("ciudad_origen") = ciudad_origen
MANIF("ciudad_destino") = ciudad_destino
MANIF("tipo_paquete") = tipo
MANIF("codigo_empresa") = Nempresa
MANIF("codigo_barra_numero") = guia_courier
If Check1.Value = 1 Then
MANIF("NM") = 1
Else
MANIF("NM") = 0
End If
MANIF("guia_aerea") = madre
MANIF.Update
guias_buenas = guias_buenas + 1
ProgressBar1.Value = CInt(Abs(i - guias_existentes) * (ProgressBar1.Max / (k - guias_existentes)))
End If
Next i
ProgressBar1.Visible = False
MsgBox "Registros Importados Correctamente.", vbInformation
ElseIf guias_malas > 0 Then
MsgBox "Existen " & guias_malas & " Guías Mal Manifestadas.", vbInformation
CrystalReport2.ReportFileName = "p:\aduanas\Reportes\malmanifiesto.rpt"
CrystalReport2.Action = 1
ElseIf guias_existentes = k Then
MsgBox "La Guía Madre ya fue Manifestada.", vbInformation
End If
errImportar:
If Err.Number <> 0 Then
MsgBox "Ha ocurrido el Error: " & Err.Description
End If
End Sub
Private Sub Command2_Click()
Set temporal = Workspaces(0).OpenDatabase("c:\bases\temporal.MDB")
Set MALMANIF = temporal.OpenRecordset("MalManifestados", dbOpenTable)
If MALMANIF.EOF = False Then
Do While MALMANIF.EOF = False
MALMANIF.Delete
MALMANIF.MoveNext
Loop
End If
MALMANIF.Close
temporal.Close
Unload Me
frmmain.Enabled = True
End Sub
Private Sub Command3_Click()
Dim manifiestoR As Recordset
Dim var As Boolean
On Error GoTo updateerr
Set inventario = Workspaces(0).OpenDatabase("p:\bases\inventario.MDB")
Set manifiestoR = inventario.OpenRecordset("manifiesto", dbOpenTable)
var = False
If txtGuia.Text = "" Then
MsgBox "Ingrese la Guía Madre.", vbExclamation
Exit Sub
End If
manifiestoR.Index = "Guia_Madre"
manifiestoR.Seek "=", txtGuia
If manifiestoR.NoMatch = False Then
Do While manifiestoR.EOF = False
If manifiestoR("peso_aforo") > 0 And manifiestoR("GUIA_MADRE") = txtGuia Then
var = True
Exit Do
ElseIf manifiestoR("GUIA_MADRE") <> txtGuia Then
Exit Do
Else
manifiestoR.MoveNext
End If
If manifiestoR.EOF = True Then
Exit Do
End If
Loop
If var = True Then
MsgBox "No puede reversar, las guías ya fueron aforadas.", vbCritical
Else
manifiestoR.MoveFirst
manifiestoR.Index = "Guia_Madre"
manifiestoR.Seek "=", txtGuia
Do While manifiestoR.EOF = False
If manifiestoR("GUIA_MADRE") = txtGuia Then
manifiestoR.Delete
manifiestoR.MoveNext
Else
Exit Do
End If
If manifiestoR.EOF = True Then
Exit Do
End If
Loop
MsgBox "Los datos fueron reversados satisfactoriamente.", vbExclamation
End If
Else
MsgBox "La guía Madre no existe.", vbInformation
End If
inventario.Close
updateerr:
If Err.Number > 0 Then
MsgBox Err.Description
End If
End Sub
Private Sub Command4_Click()
CommonDialog1.ShowOpen
TxtFile.Text = CommonDialog1.FileName
End Sub
Private Sub Command5_Click()
If OpImp = 2 Then
txtGuia.Text = ""
txtGuia.SetFocus
Else
TxtGuiaAerea.Text = ""
TxtFile.Text = ""
cmdImportar.Enabled = True
dblempresa.SetFocus
ProgressBar1.Visible = False
End If
End Sub
Private Sub dblempresa_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{Tab}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
Dim rstTemp As Recordset
On Error GoTo updateerr
Set inventario = Workspaces(0).OpenDatabase("p:\bases\inventario.MDB", False, False, ";pwd=yo;")
Set rstTemp = inventario.OpenRecordset("empresa")
While Not rstTemp.EOF
dblempresa.AddItem rstTemp!empresa
dblempresa.ListIndex = i
rstTemp.MoveNext
Wend
rstTemp.Close
inventario.Close
updateerr:
If Err.Number > 0 Then
MsgBox Err.Description
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo updateerr
Set temporal = Workspaces(0).OpenDatabase("c:\bases\temporal.MDB")
Set MALMANIF = temporal.OpenRecordset("MalManifestados", dbOpenTable)
If MALMANIF.EOF = False Then
Do While MALMANIF.EOF = False
MALMANIF.Delete
MALMANIF.MoveNext
Loop
End If
MALMANIF.Close
temporal.Close
updateerr:
If Err.Number > 0 Then
MsgBox Err.Description
End If
End Sub
Private Sub txtfile_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{Tab}"
KeyAscii = 0
End If
End Sub
Private Sub txtGuia_KeyPress(KeyAscii As Integer)
LOWERCASE_LETTERS_OK = False 'NO MINUSCULAS
UPPERCASE_LETTERS_OK = True 'SI MAYUSCULAS
DIGITS_OK = True 'SI numeros
LEADING_MINUS_OK = False
SINGLE_DECIMAL_OK = False 'NO PUNTO decimal
PLUS_OK = False
If KeyAscii = 13 Then
SendKeys "{Tab}"
KeyAscii = 0
End If
Call Filtrado(KeyAscii, LOWERCASE_LETTERS_OK, UPPERCASE_LETTERS_OK, DIGITS_OK, LEADING_MINUS_OK, SINGLE_DECIMAL_OK, PLUS_OK)
End Sub
Private Sub TxtGuiaAerea_GotFocus()
TxtGuiaAerea.SelStart = 0
TxtGuiaAerea.SelLength = Len(TxtGuiaAerea.Text)
End Sub
Private Sub TxtGuiaAerea_KeyPress(KeyAscii As Integer)
LOWERCASE_LETTERS_OK = False 'NO MINUSCULAS
UPPERCASE_LETTERS_OK = True 'SI MAYUSCULAS
DIGITS_OK = True 'SI numeros
LEADING_MINUS_OK = False
SINGLE_DECIMAL_OK = False 'NO PUNTO decimal
PLUS_OK = False
If KeyAscii = 13 Then
SendKeys "{Tab}"
KeyAscii = 0
End If
Call Filtrado(KeyAscii, LOWERCASE_LETTERS_OK, UPPERCASE_LETTERS_OK, DIGITS_OK, LEADING_MINUS_OK, SINGLE_DECIMAL_OK, PLUS_OK)
End Sub