home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / VB_Decompi2142181302009.psc / GlobalDims.bas < prev   
BASIC Source File  |  2009-01-10  |  5KB  |  106 lines
  1. Attribute VB_Name = "GlobalDims"
  2. ' VB Decompiler Lite
  3. ' Programmed By [ Zaid Markabi ]
  4. ' ___________________________________________________________________________________________________
  5. '|                                                                                                   |\_______________________
  6. '|  ###############        ###         #####   ######                ######    #####                 |                        |\0 1 1 1 0 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 1
  7. '| ##############         #####         ###     ##   ##               ######  #####                  |      Zaid Markabi      |=\ 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 0
  8. '|         ####          ### ###        ###     ##    ##              ##  ## ##  ##                  |                        |==\0 0 1 1 1 0 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 1 0 0 1 0 1 1
  9. '|       ###            ###   ###       ###     ##     ##    #####    ##   ###   ##                  | zaidmarkabi@yahoo.com  |===\ 1 __________________________________  0 1 0 0 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1
  10. '|     ###             ###########      ###     ##     ##   ####      ##    #    ##                  |                        |====|>| Development For Our Digital Life | 1 1 0 0 1 1 1 0 1 0 0 1 0 0 0 1 1 0 1 0
  11. '|   ###              #############     ###     ##    ##              ##         ##      A R K A B I | VisualBasic Programmer |===/ 1|__________________________________| 0 1 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 0 0
  12. '| ##############    ###         ###    ###     ##   ##               ##         ##     ############ |                        |==/0 0 1 1 1 0 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 1 0 0 1 0 1 1
  13. '| ###############   ###         ###   #####   ######                ####       ####   ### 2009 ###  |Syria ( Arabic )-Tartous|=/ 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 0
  14. '|                                                                                    ############   | _______________________|/0 1 1 1 0 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 1
  15. '|___________________________________________________________________________________________________|/
  16. '
  17. ' Em@il    : zaidmarkabi@yahoo.com
  18. ' Web site : www.YazanMarkabi.Jeeran.com
  19. '            I hope to hear from you ,
  20.  
  21. Global FileName As String
  22. Global FilePath As String
  23.  
  24. Global CHAR As Byte
  25. Global CHARn() As Byte
  26. Global FilePos As Long
  27. Global LastSentenceText As String
  28. Global LastSavedSentence As String
  29. Global MaxSentenceLong As Integer
  30.  
  31. Function LoadImage(FileName) As Boolean
  32. On Error GoTo Err
  33. LoadImage = False
  34. frmExtractingData.LastImage.Picture = LoadPicture(FileName)
  35. LoadImage = True
  36. Exit Function
  37. Err:
  38. End Function
  39.  
  40.  
  41. Function IfItIsLettel(StrText As String) As Boolean
  42. If InStr(1, "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz :-_0123456789", StrText) > 0 Then
  43. IfItIsLettel = True
  44. Else
  45. IfItIsLettel = False
  46. End If
  47. End Function
  48.  
  49.  
  50. Sub ExtractNext()
  51. Dim I As Integer
  52.  
  53. If EOF(1) = False Then
  54.  
  55. Dim FileHeader As String
  56. Dim FileType As String
  57. Dim HeaderLong As Long
  58.  
  59. ' Get the next header ( 3 charts is enough )
  60. For I = 0 To 2
  61. Get #1, FilePos + I, CHAR
  62. FileHeader = FileHeader + Chr(CHAR)
  63. Next
  64. Get #1, FilePos, CHAR
  65.  
  66. If frmExtractingData.ChkImages.Value = 1 Then
  67. ' Define types of images ( Headers )
  68. If Left(UCase(FileHeader), 2) = "BM" Then
  69. FileType = "Bmp"
  70. HeaderLong = 0
  71. End If
  72. If UCase(FileHeader) = "JFI" Then
  73. FileType = "Jpg"
  74. HeaderLong = 6
  75. FilePos = FilePos - 6
  76. End If
  77. ' Gif and Png in FULL version
  78.  
  79. '  Extracting Images ( Jpeg , Bmp , Gif , Png )
  80. If FileType = "Bmp" Or FileType = "Jpg" Or FileType = "Gif" Or FileType = "Png" Then
  81. ReDim CHARn(LOF(1) - FilePos)
  82. Get #1, FilePos, CHARn
  83. Open App.Path + "\Temp\" + Mid(FileName, Len(FilePath) + 1, Len(FileName) - Len(FilePath) - 4) + Format(FilePos, "000000000000000") + "." + FileType For Binary As #2
  84. Put #2, 1, CHARn
  85. Close #2
  86. If LoadImage(App.Path + "\Temp\" + Mid(FileName, Len(FilePath) + 1, Len(FileName) - Len(FilePath) - 4) + Format(FilePos, "000000000000000") + "." + FileType) = True Then
  87. If FileType = "Bmp" Then
  88. SavePicture frmExtractingData.LastImage.Picture, App.Path + "\Temp\" + Mid(FileName, Len(FilePath) + 1, Len(FileName) - Len(FilePath) - 4) + Format(FilePos, "000000000000000") + "." + FileType
  89. End If
  90. Open App.Path + "\Temp\" + Mid(FileName, Len(FilePath) + 1, Len(FileName) - Len(FilePath) - 4) + Format(FilePos, "000000000000000") + "." + FileType For Binary As #3
  91. HeaderLong = LOF(3)
  92. Close #3
  93. GoTo ImgEx
  94. Else
  95. Kill App.Path + "\Temp\" + Mid(FileName, Len(FilePath) + 1, Len(FileName) - Len(FilePath) - 4) + Format(FilePos, "000000000000000") + "." + FileType
  96. End If
  97. End If
  98. End If
  99.  
  100. If frmExtractingData.ChkSentences.Value = 1 Then
  101. ' Extract Sentences
  102. If IfItIsLettel(Chr(CHAR)) = True Then
  103. LastSentenceText = LastSentenceText + Chr(CHAR)
  104.  Then
  105. 'BinChr(CHAR)
  106.  Thni