Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Flash Info Reader

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Flash Info Reader

    Flash Info Reader
    by TheirCorp


    This utility displays very limited information about uncompressed
    flash (.SWF) files. Unfortunately many, if not most are (zlib)
    compressed.

    * Frame dimensions
    * Frame count
    * Frames per second
    * Tags: code, length and type

    To get flash files from your browser's cache, you can use
    Open File Lister's compare feature. The size might be shown
    as zero while it's open by the other process.

    You can find the Flash format (version 9) specification at:
    http://www.adobe.com/devnet/swf/ (1.9 MB)

    For related source code:
    • Gnash - swf movie player
    • SwfDec - a decoder/renderer for Macromedia Flash animations.
    • SwfDotNet - library for writing, reading and generating Flash(tm) Swf files

    The source code ("FlashInfo.bas")
    Code:
    '**************************************
    '	"FlashInfo.bas"
    
    'This file is public domain 2008, by TheirCorp
    '**************************************
    
    #Compile Exe "FlashInfo.exe"
    #Dim All
    
    '**************************************
    
    '%Debug		= 1 'enable/disable debugging code
    
    #If %Def(%Debug)
    #Tools On
    '%ProfileOn		= 1
    
    Global dbg		As Long
    Global dbs		As String
    
    Sub zz()
    
    End Sub 'zz
    
    #Else
    	#Tools Off
    
    #EndIf
    
    '**************************************
    
    $Caption = "TheirCorp's Flash Info Reader"
    
    %GoBtn   = 1001
    %PathTxt = 1101
    %LogTxt  = 1102
    %FileLbl = 1103
    %MsgLbl  = 1104
    
    %LogLines = 8
    '%fo  	  = 10 'output file's number
    Macro fo = 10 'output file's number
    %IsOpen		= 0
    
    Global ghDlg		As Dword
    Global LocalPath	As String   'local path
    
    '**************************************
    
    %SUBDIR				   = 16
    %WINAPI				   = 1
    %WM_USER			   = &H400
    %TRUE				   = 1
    %FALSE				   = 0
    %MAX_PATH			   = 260 ' max. length of full pathname
    %MAX_EXT			   = 256
    
    %WM_DESTROY			   = &H2
    %WM_SETFONT			   = &H30
    %WM_COMMAND			   = &H111
    %WM_DROPFILES		   = &H233
    %WM_NCACTIVATE		   = &H86
    %WM_INITDIALOG		   = &H110
    
    %WS_CHILD			   = &H40000000
    %WS_TABSTOP			   = &H00010000
    %WS_MINIMIZEBOX		   = &H00020000
    %WS_POPUP			   = &H80000000
    %WS_VISIBLE			   = &H10000000
    %WS_CLIPSIBLINGS	   = &H04000000
    %WS_CAPTION			   = &H00C00000 ' WS_BORDER OR WS_DLGFRAME
    %WS_BORDER			   = &H00800000
    %WS_DLGFRAME		   = &H00400000
    %WS_SYSMENU			   = &H00080000
    %WS_VSCROLL			   = &H00200000
    %WS_HSCROLL			   = &H00100000
    
    %WS_EX_LEFT			   = &H00000000
    %WS_EX_LTRREADING	   = &H00000000
    %WS_EX_RIGHTSCROLLBAR  = &H00000000
    %WS_EX_CONTROLPARENT   = &H00010000
    %WS_EX_WINDOWEDGE	   = &H00000100
    %WS_EX_CLIENTEDGE	   = &H00000200
    %WS_EX_ACCEPTFILES	   = &H00000010
    %WS_EX_TOOLWINDOW	   = &H00000080
    
    %HWND_DESKTOP			   = 0
    
    %BN_CLICKED				   = 0
    %BS_TEXT				   = &H0&
    %BS_PUSHBUTTON			   = &H0&
    %BS_GROUPBOX			   = &H7&
    %BS_CENTER				   = &H300&
    %BS_TOP					   = &H400&
    %BS_VCENTER				   = &HC00&
    %BS_DEFPUSHBUTTON		   = &H1&
    %BS_ICON				   = &H40&
    %BS_BITMAP				   = &H80&
    
    %DM_SETDEFID			   = %WM_USER + 1
    
    %DS_3DLOOK				   = &H0004&
    %DS_MODALFRAME			   = &H0080& ' Can be combined with WS_CAPTION
    %DS_NOFAILCREATE		   = &H0010&
    %DS_SETFONT				   = &H0040& ' User specified font for Dlg controls
    %DS_SETFOREGROUND		   = &H0200& ' not in win3.1
    
    %ES_LEFT		 = &H0&
    %ES_MULTILINE	 = &H4&
    %ES_AUTOVSCROLL  = &H40&
    %ES_AUTOHSCROLL  = &H80&
    %ES_WANTRETURN   = &H1000&
    
    %EM_SCROLL		 = &HB5
    %EM_SCROLLCARET  = &HB7
    %EM_SETSEL		 = &HB1
    
    %SS_CENTER					  = &H00000001
    %SS_RIGHT					  = &H00000002
    
    '**************************************
    '	Declares
    '**************************************
    
    Declare Function GetModuleFileName Lib "KERNEL32.DLL" Alias "GetModuleFileNameA" (ByVal hModule As Dword, lpFileName As Asciiz, ByVal nSize As Dword) As Dword
    Declare Sub DragAcceptFiles Lib "SHELL32.DLL" Alias "DragAcceptFiles" (ByVal hwnd As Dword, ByVal fAccept As Long)
    Declare Sub DragFinish Lib "SHELL32.DLL" Alias "DragFinish" (ByVal hDrop As Dword)
    Declare Function DragQueryFile Lib "SHELL32.DLL" Alias "DragQueryFileA" (ByVal hDrop As Dword, ByVal uiFile As Dword, lpStr As Asciiz, ByVal cch As Dword) As Dword
    
    Declare Function GetFocus Lib "USER32.DLL" Alias "GetFocus" () As Dword
    Declare Function SetFocus Lib "USER32.DLL" Alias "SetFocus" (ByVal hWnd As Dword) As Long
    
    '**************************************
    
    ' Tag values that represent actions or data in a Flash script.
    %End					= 0
    %ShowFrame				= 1
    %DefineShape			= 2
    %FreeCharacter			= 3
    %PlaceObject			= 4
    %RemoveObject			= 5
    %DefineBits				= 6
    %DefineButton			= 7
    %JPEGTables				= 8
    %SetBackgroundColor		= 9
    %DefineFont				= 10
    %DefineText				= 11
    %DoAction				= 12
    %DefineFontInfo			= 13
    %DefineSound			= 14 ' Event sound tags.
    %StartSound				= 15
    '	16
    %DefineButtonSound		= 17
    %SoundStreamHead		= 18
    %SoundStreamBlock		= 19
    %DefineBitsLossless		= 20 ' A bitmap using lossless zlib compression.
    %DefineBitsJPEG2		= 21 ' A bitmap using an internal JPEG compression table.
    %DefineShape2			= 22
    %DefineButtonCxform		= 23
    %Protect				= 24 ' This file should not be importable for editing.
    '	25
    ' These are the new tags for Flash 3.
    %PlaceObject2			= 26 ' The new style place w/ alpha color transform and name.
    '	27
    %RemoveObject2			= 28 ' A more compact remove object that omits the character tag (just depth).
    '	29 - 31
    %DefineShape3			= 32 ' A shape V3 includes alpha values.
    %DefineText2			= 33 ' A text V2 includes alpha values.
    %DefineButton2			= 34 ' A button V2 includes color transform, alpha and multiple actions
    %DefineBitsJPEG3		= 35 ' A JPEG bitmap with alpha info.
    %DefineBitsLossless2	= 36 ' A lossless bitmap with alpha info.
    %DefineEditText			= 37 ' An editable Text Field
    '	38
    %DefineSprite			= 39 ' Define a sequence of tags that describe the behavior of a sprite.
    %NameCharacter			= 40 ' Name a character definition, character id and a string, (used for buttons, bitmaps, sprites and sounds).
    '	41 - 42
    %FrameLabel				= 43 ' A string label for the current frame.
    '	44
    %SoundStreamHead2		= 45 ' For lossless streaming sound, should not have needed this...
    %DefineMorphShape		= 46 ' A morph shape definition
    '	47
    %DefineFont2			= 48 '
    
    'Some even newer tags...
    ' 49 - 55
    %ExportAssets				= 56
    %ImportAssets				= 57
    %EnableDebugger				= 58
    %DoInitAction				= 59
    %DefineVideoStream			= 60
    %VideoFrame					= 61
    %DefineFontInfo2			= 62
    ' 63
    %EnableDebugger2			= 64
    %ScriptLimits				= 65
    %SetTabIndex				= 66
    ' 67 - 68
    %FileAttributes				= 69
    %PlaceObject3				= 70
    %ImportAssets2				= 71
    ' 72
    %DefineFontAlignZones		= 73
    %CSMTextSettings			= 74
    %DefineFont3				= 75
    %SymbolClass				= 76
    %MetaData					= 77
    %DefineScalingGrid			= 78
    ' 79 - 81
    %DoABC						= 82
    %DefineShape4				= 83
    %DefineMorphShape2			= 84
    ' 85
    %DefineSceneAndFrameLabelData	= 86
    %DefineBinaryData			= 87
    %DefineFontName				= 88
    %StartSound2				= 89
    
    '**************************************
    
    'the FlashHeader size is variable beyond the "nLen"
    'element, so that portion is REMed out
    Type FlashHeader
    	Sig		As String * 3 ' = "FWS" ("SWF" backward)
    	Ver		As Byte 'flash version
    	nLen	As Dword 'file length in bytes
    	'zFram	As SRECT 'frame size in TWIPS
    	'nRate	As Word 'frame delay in 8.8 fixed number of frames per second
    	'nFram	As Word 'total number of frames in movie
    End Type 'FlashHeader
    
    
    'the SRECT structure in a SWF file is composed of variable-
    'length bit fields. this "TRECT" structure is being used
    'to store the values after retrieving them from an SRECT
    Type TRECT
    	xMin	As Long
    	xMax	As Long
    	yMin	As Long
    	yMax	As Long
    End Type
    
    
    'short header
    '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
    '	|               |               |               |               |
    '	| 15  14  13  12| 11  10  9   8 | 7   6   5   4 | 3   2   1   0 |
    '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
    '	|   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |
    '	|                                       |                       |
    '	|              Tag                      |     Length            |
    '	|                                       |                       |
    '	|   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |
    '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
    
    
    'long header
    '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
    '	|               |               |               |               |
    '	| 15  14  13  12| 11  10  9   8 | 7   6   5   4 | 3   2   1   0 |
    '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
    '	|   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |
    '	|                                       |                       |
    '	|              Tag                      |        &H3F           |
    '	|                                       |                       |
    '	|   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |
    '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
    '...followed by a Dword length value
    
    
    '**************************************
    
    Global q		As Quad
    Global Byt()	As Byte
    Global Dwd()	As Dword
    Global rct		As TRECT
    
    '**************************************
    
    'Using Static variables eliminates the need for
    'creating them on the stack
    
    '"Byt()" and "Dwd()" are Globals, so they can be
    'DIMed from inside DeFlash
    
    '"q" and "rct" are Globals, so they don't have to
    'be passed as parameters
    
    Function ReadRect(ps As String) As Long
    #Register All
    Static p		As Byte 'offset into ps
    Static nBits	As Byte 'number of bits per value
    Static iBit		As Byte 'index of value's first bit
    Static nExtra	As Byte 'count of extra trailing bits
    Static iField	As Byte 'index for Dwd()
    
    Static iSign	As Byte 'index of the sign-bit
    Static fSign	As Dword 'holds the sign extension bits
    Static bSign	As Dword '2 ^ nBits for extending a negative sign
    Static fMask	As Dword 'to mask out trailing bits
    
    
    'for swapping bytes in Byt()
    Static iByte	As Byte 'index of byte containing valid bits
    Static iMax		As Byte 'index of byte containing valid bits
    
    
    	'get the number of bits per value (equivalent of: nBits = Asc(ps) \ 8)
    	nBits = Asc(ps)
    	Shift Right nBits, 3
    
    	'sign-extension masks
    	iSign = nBits - 1 'index of the sign-bit
    	bSign = 1 : Shift Left bSign, nBits ' bSign = (2 ^ nBits)... mask for sign extension
    
    	fMask = bSign - 1 'mask to remove extra high bits
    
    	fSign = Not fMask 'mask to add negative sign bits
    
    	nExtra = 5 ' count of extra bits
    	iBit = 5 'index of first bit of current value
    
    	For iField = 0 To 3
    
    		p = (iBit \ 8) + 1 'offset to the first byte of the bit value to retrieve
    
    		q = Cvq(ps, p) 'Load a Quad full of bits
    
    		'Swap all valid bytes to convert it to big-endian (Byt() is DIMed on top of q)
    		iByte = 0
    		iMax = (8 - nExtra + nBits) \ 8
    		Do Until iByte => iMax
    			Swap Byt(iByte), Byt(iMax)
    			Incr iByte
    			Decr iMax
    		Loop
    
    		nExtra = (8 - ((iBit + nBits) And 7)) And 7 'count of trailing (extra) bits
    		Shift Right q, nExtra 'Shift out the trailing (extra) bits
    
    		Dwd(iField) = q 'Store in Dword (it's DIMed on top of a TRECT field)
    
    		Dwd(iField) = Dwd(iField) And fMask 'Mask out extra high bits
    
    		'Extend the sign bit, if needed
    		If Bit(Dwd(iField), iSign) Then Dwd(iField) = Dwd(iField) Or fSign
    
    		'advance to the first bit of the next value (zero-based)
    		iBit = iBit + nBits
    
    	Next iField
    
    	'Function = 1 'success
    
    End Function 'ReadRect
    
    '**************************************
    
    Function DeFlash(cs As String) As Long
    #Register All
    Local p			As Long
    Local cnt		As Long
    Local nLen		As Long
    Local vTag		As Long
    Local FlsHdr	As FlashHeader
    
    Data "End"
    Data "Show Frame"
    Data "Define Shape"
    Data "Free Character"
    Data "Place Object"
    Data "Remove Object"
    Data "Define Bits"
    Data "Define Button"
    Data "JPEG Tables"
    Data "Set Background Color"
    Data "Define Font"
    Data "Define Text"
    Data "Do Action"
    Data "Define Font Info"
    Data "Define Sound"
    Data "Start Sound"
    Data
    Data "Define Button Sound"
    Data "Sound Stream Head"
    Data "Sound Stream Block"
    Data "Define Bits Lossless"
    Data "Define Bits JPEG2"
    Data "Define Shape2"
    Data "Define Button CX Form"
    Data "Protect"
    Data
    Data "Place Object 2"
    Data
    Data "Remove Object 2"
    Data ,,
    Data "Define Shape 3"
    Data "Define Text 2"
    Data "Define Button 2"
    Data "Define Bits JPEG 3"
    Data "Define Bits Lossless 2"
    Data "Define Edit Text"
    Data
    Data "Define Sprite"
    Data "Name Character"
    Data ,
    Data "Frame Label"
    Data
    Data "Sound Stream Head 2"
    Data "Define Morph Shape"
    Data
    Data "Define Font 2"
    '	49 - 55
    Data ,,,,,,
    Data "ExportAssets"
    Data "ImportAssets"
    Data "EnableDebugger"
    Data "DoInitAction"
    Data "DefineVideoStream"
    Data "VideoFrame"
    Data "DefineFontInfo2"
    '	63
    Data
    Data "EnableDebugger2"
    Data "ScriptLimits"
    Data "SetTabIndex"
    '	67 - 68
    Data ,
    Data "FileAttributes"
    Data "PlaceObject3"
    Data "ImportAssets2"
    '	72
    Data
    Data "DefineFontAlignZones"
    Data "CSMTextSettings"
    Data "DefineFont3"
    Data "SymbolClass"
    Data "MetaData"
    Data "DefineScalingGrid"
    '	79 - 81
    Data ,,
    Data "DoABC"
    Data "DefineShape4"
    Data "DefineMorphShape2"
    '	85
    Data
    Data "DefineSceneAndFrameLabelData"
    Data "DefineBinaryData"
    Data "DefineFontName"
    Data "StartSound2"
    
    	Dim Dwd(4)	As Dword At VarPtr(rct) 'place Dword array on top of the TRECT structure
    	Dim Byt(8)	As Byte At VarPtr(q)	'place Byte array on top of "q" (a Quad variable)
    
    	LSet FlsHdr = cs
    	' "FWS" = normal, uncompressed
    	' "CWS" = beyond the eighth byte is compressed with z-lib
    	If FlsHdr.Sig <> "FWS" Then Exit Function
    	Print# fo, "Signature:		"; FlsHdr.Sig
    	Print# fo, "Flash version:	"; Format$(FlsHdr.Ver)
    	Print# fo, "File length:	"; Format$(FlsHdr.nLen)
    
    	ReadRect(Mid$(cs, 9, 32))
    	Print# fo,
    	Print# fo, "Frame dimensions (Twips, Pixels)"
    	Print# fo, "	Left:	"; Format$(rct.xMin);   ",	"; Format$(rct.xMin\20)
    	Print# fo, "	Top:	"; Format$(rct.yMin);    ",	"; Format$(rct.yMin\20)
    	Print# fo, "	Right:	"; Format$(rct.xMax);  ",	"; Format$(rct.xMax\20)
    	Print# fo, "	Bottom:	"; Format$(rct.yMax); ",	"; Format$(rct.yMax\20)
    	Print# fo,
    
    	'go past frame dimensions (TRECT)
    	p = 9 + ((12 + ((Asc(cs, 9) \ 8) * 4)) \ 8) ' = 9 + ((5 + 7 + ((Asc(cs, 9) \ 8) * 4)) \ 8)
    
    	Print# fo,
    	Print# fo, "Frame rate:	"; Format$(Asc(cs, p + 1)); "."; Format$(Asc(cs, p))
    
    	p = p + 2
    	Print# fo, "Frame count:	" Format$(CvWrd(cs, p))
    
    	p = p + 2
    	Print# fo,
    	Print# fo, "------------------------------------------"
    	Print# fo, "Tag				Tag"
    	Print# fo, "Code	Length	Type"
    	Print# fo, "------------------------------------------"
    	Do While p < Len(cs)
    
    		nLen = CvWrd(cs, p)
    		p = p + 2
    
    		vTag = nLen
    		Shift Right vTag, 6
    		nLen = nLen And &H03F
    
    		If nLen = &H03F Then 'long header
    			nLen = CvDwd(cs, p)
    			p = p + 4
    		End If
    
    		Print# fo, Format$(vTag); ",		"; Format$(nLen); ",		";  Read$(vTag + 1)
    
    		p = p + nLen
    		Incr cnt
    
    	Loop
    
    	'Function =
    
    End Function
    
    '**************************************
    
    Sub UpdateLog(ps As String)
    Static ct   As Long
    Static ls   As String
    Static ts   As String
    
    	If Len(Command$) Then
    		'MsgBox ps
    
    	Else
    		Incr ct
    
    		If Len(ps) Then
    			'Control Get Text ghDlg, %LogTxt To ls
    			'Dialog DoEvents
    			ps = ps & $CrLf
    		Else
    			ct = 1
    			ls = ""
    			ts = ""
    		End If
    
    		If ct > %LogLines Then ts = Remain$(ts, $CrLf) & ps
    		ls = ls & ps
    
    		If Left$(ps, 5) = "Ready" Then
    			Control Set Text ghDlg, %LogTxt, LTrim$(Left$(ls, 32000), Any $CrLf)
    			Dialog DoEvents
    			Control Send ghDlg, %LogTxt, %EM_SETSEL, 65536, 65536
    			Dialog DoEvents
    			Control Send ghDlg, %LogTxt, %EM_SCROLLCARET, 0, 0
    			Dialog DoEvents
    		Else
    			Control Set Text ghDlg, %LogTxt, ts
    		End If
    
    	End If
    
    End Sub 'UpdateLog
    
    '**************************************
    'returns %true, if any files were received
    Function GetDroppedFile(ByVal hDrop As Long, fs As String) As Long
    Local ct  As Dword
    Local az  As Asciiz * %MAX_PATH
    
    	ct = DragQueryFile(hDrop, &HFFFFFFFF&, "", ByVal 0&)
    
    	If ct > 0 Then
    		az = Space$(%MAX_PATH)
    		ct = DragQueryFile(hDrop, 0, az, Len(az) - 1)
    		fs = Left$(az, ct)
    		Function = %True
    	End If
    
    End Function
    
    '**************************************
    'expects "fs" to contain the path and name
    Function ProcessFile(fs As String) As Long
    Local ff	As Long
    Local n		As Long
    Local cs	As String
    Local ls	As String
    
    	If Len(Dir$(fs)) Then
    
    		'--------------------------------------
    		'get the flash data
    		Try
    			ff = FreeFile
    			Open fs For Binary Access Read Lock Shared As #ff
    			Get$ #ff, Lof(ff), cs
    			Close# ff
    		Catch
    		End Try
    
    		UpdateLog "Processing..."
    
    		'--------------------------------------
    		'open an output file
    		Try
    			ls = Mid$(fs, InStr(-1, fs, "\") + 1)
    			ls = MCase$(Extract$(ls, ".")) & ".txt"
    			Open LocalPath & "\" & ls For Output As fo
    			UpdateLog "Output file: " & ls
    		Catch
    			UpdateLog "Error opening output file: " & ls
    			Exit Function
    		End Try
    
    		Print# fo, "File: "; Mid$(fs, Instr(-1, fs, "\") + 1)
    		DeFlash(cs)
    
    	Else
    		UpdateLog "Couldn't find: " & fs
    	End If
    
    	If FileAttr(fo, %IsOpen) Then Close# fo
    
    End Function 'ProcessFile
    
    '**************************************
    
    CallBack Function ShowDlgProc()
    Local  fs   As String
    
    #If %Def(%ProfileOn)
    	Profile "Profile.txt"
    #EndIf
    
    	Select Case As Long CbMsg
    
    		'Case %WM_INITDIALOG
    
    		Case %WM_NCACTIVATE
    			Static hWndSaveFocus  As Dword
    			If IsFalse CbWParam Then
    				hWndSaveFocus = GetFocus()
    			ElseIf hWndSaveFocus Then
    				SetFocus(hWndSaveFocus)
    				hWndSaveFocus = 0
    			End If
    
    		Case %WM_DROPFILES
    			If (GetDroppedFile(CbWParam, fs)) Then
    				Control Set Text ghDlg, %PathTxt, fs
    			End If
    			DragFinish CbWParam
    
    		Case %WM_COMMAND
    			Select Case As Long CbCtl
    				Case %GoBtn
    					If CbCtlMsg = %BN_CLICKED Or CbCtlMsg = 1 Then
    						Control Get Text ghDlg, %PathTxt To fs
    						UpdateLog ""
    						ProcessFile(fs)
    						UpdateLog "Ready..."
    					End If
    			End Select
    
    	End Select
    
    End Function
    
    '**************************************
    
    Function PBMain() As Long
    Local lRslt As Long
    
    #If %Def(%ProfileOn)
    	Profile "Profile.txt"
    #EndIf
    
    	'get and save the local path without a trailing backslash
    	LocalPath = String$(%MAX_PATH, $Nul)
    	GetModuleFileName(ByVal 0, ByVal StrPtr(LocalPath), %MAX_PATH)
    	LocalPath = Left$(LocalPath, InStr(-1, LocalPath, "\") - 1)
    
    
    	If Len(Command$) Then
    
    		ProcessFile(Command$)
    		MsgBox "Done"
    
    	Else
    
    		Dialog New %HWND_DESKTOP, $Caption, , , 256, 138, %WS_POPUP Or %WS_BORDER _
    			Or %WS_DLGFRAME Or %WS_CAPTION Or %WS_SYSMENU Or %WS_MINIMIZEBOX Or _
    			%WS_VISIBLE Or %DS_MODALFRAME Or %DS_SETFOREGROUND Or %DS_3DLOOK Or _
    			%DS_NOFAILCREATE Or %DS_SETFONT, %WS_EX_WINDOWEDGE Or _
    			%WS_EX_ACCEPTFILES Or %WS_EX_CONTROLPARENT Or %WS_EX_LEFT Or _
    			%WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR, To ghDlg
    
    		Control Add Label,   ghDlg, %FileLbl, "&File:", 0, 4, 19, 10, %WS_CHILD Or _
    			%WS_VISIBLE Or %WS_TABSTOP Or %SS_RIGHT, %WS_EX_LEFT Or %WS_EX_LTRREADING
    
    		Control Add TextBox, ghDlg, %PathTxt, "", 20, 2, 233, 12
    
    		Control Add Button,  ghDlg, %GoBtn, "&Go", 220, 17, 32, 14, %WS_CHILD Or _
    			%WS_VISIBLE Or %WS_BORDER Or %WS_TABSTOP Or %BS_TEXT Or _
    			%BS_DEFPUSHBUTTON Or %BS_PUSHBUTTON Or %BS_CENTER Or %BS_VCENTER, _
    			%WS_EX_LEFT Or %WS_EX_LTRREADING
    
    		Control Add Label, ghDlg, %MsgLbl, "&Messages:", 2, 22, 39, 10
    
    		Control Add TextBox, ghDlg, %LogTxt, "", 2, 34, 252, 100, %WS_CHILD Or _
    			%WS_VISIBLE Or %WS_TABSTOP Or %WS_HSCROLL Or %WS_VSCROLL Or %ES_LEFT _
    			Or %ES_MULTILINE Or %ES_AUTOHSCROLL Or %ES_AUTOVSCROLL Or %ES_WANTRETURN, _
    			%WS_EX_CLIENTEDGE Or %WS_EX_LEFT Or %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR
    
    		Dialog Send ghDlg, %DM_SETDEFID, %GoBtn, 0
    		Control Set Focus ghDlg, %PathTxt
    
    		DragAcceptFiles ghDlg, %True 'Register window to accept dropped files.
    
    		Dialog Show Modal ghDlg, Call ShowDlgProc To lRslt
    
    		Function = lRslt
    
    	End If
    
    End Function
    
    '**************************************
    Sample output:
    Code:
    File: bluedotline.swf
    Signature:		FWS
    Flash version:	4
    File length:	2277
    
    Frame dimensions (Twips, Pixels)
    	Left:	0,	0
    	Top:	0,	0
    	Right:	12000,	600
    	Bottom:	2000,	100
    
    
    Frame rate:	12.0
    Frame count:	70
    
    ------------------------------------------
    Tag				Tag
    Code	Length	Type
    ------------------------------------------
    9,		3,		Set Background Color
    25,		0,		
    36,		462,		Define Bits Lossless 2
    2,		42,		Define Shape
    26,		10,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		7,		Place Object 2
    1,		0,		Show Frame
    2,		42,		Define Shape
    26,		10,		Place Object 2
    26,		7,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		7,		Place Object 2
    2,		42,		Define Shape
    26,		10,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		7,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    26,		7,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		9,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    26,		9,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    26,		8,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    26,		8,		Place Object 2
    26,		9,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    26,		8,		Place Object 2
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		8,		Place Object 2
    26,		8,		Place Object 2
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		7,		Place Object 2
    26,		8,		Place Object 2
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		7,		Place Object 2
    26,		8,		Place Object 2
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		7,		Place Object 2
    26,		7,		Place Object 2
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		17,		Place Object 2
    26,		7,		Place Object 2
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		17,		Place Object 2
    26,		7,		Place Object 2
    26,		8,		Place Object 2
    1,		0,		Show Frame
    26,		18,		Place Object 2
    26,		18,		Place Object 2
    26,		7,		Place Object 2
    1,		0,		Show Frame
    26,		17,		Place Object 2
    26,		19,		Place Object 2
    26,		7,		Place Object 2
    1,		0,		Show Frame
    26,		14,		Place Object 2
    26,		19,		Place Object 2
    26,		17,		Place Object 2
    1,		0,		Show Frame
    26,		18,		Place Object 2
    26,		19,		Place Object 2
    26,		17,		Place Object 2
    1,		0,		Show Frame
    26,		18,		Place Object 2
    26,		15,		Place Object 2
    26,		18,		Place Object 2
    1,		0,		Show Frame
    26,		18,		Place Object 2
    26,		19,		Place Object 2
    26,		17,		Place Object 2
    1,		0,		Show Frame
    26,		18,		Place Object 2
    26,		20,		Place Object 2
    26,		14,		Place Object 2
    1,		0,		Show Frame
    26,		13,		Place Object 2
    26,		20,		Place Object 2
    26,		18,		Place Object 2
    1,		0,		Show Frame
    26,		20,		Place Object 2
    26,		18,		Place Object 2
    1,		0,		Show Frame
    26,		15,		Place Object 2
    26,		18,		Place Object 2
    1,		0,		Show Frame
    26,		18,		Place Object 2
    1,		0,		Show Frame
    26,		13,		Place Object 2
    1,		0,		Show Frame
    0,		0,		End
    Edited October 2, 2008 for code improvement. Changed:
    p = 9 + ((12 + (Asc(cs, 9) \ 2)) \ 8) 'p = 9 + ((5 + 7 + ((Asc(cs, 9) \ 8) * 4)) \ 8)
    to:
    p = 9 + ((12 + ((Asc(cs, 9) \ 8) * 4)) \ 8) ' = 9 + ((5 + 7 + ((Asc(cs, 9) \ 8) * 4)) \ 8)
    The original, simplified form was unlikely to ever cause an error, since the
    "xMin" field of the SRECT is probably always zero and more than two bits long.
    The reason for dividing Asc(cs, 9) by eight is partly to remove the lowest
    three bits so that they don't affect the result.




    • TheirCorp's SourceForge project
      includes:
    • API Helper --- a code generator for the Win32 API
    • BinEditPlus --- a decompiler and more
    • ComHelper --- a code generator for the COM programming
    • "Flex" --- an editor with novel features
    • GDI Debug --- catches programming errors that could lead
      to resource leaks
    • Import Monitor --- (an API hook) Intercepts and monitors
      calls to imported functions
    • Intricately Mergeable Templates
    • Jellyfish Pro enhancer plugin (adds drag-and-drop and more..)
    • TheirEdit --- an editor for PowerBASIC code
    • TheirNote --- a KeyNote clone
    • TheirSheet --- a spreadsheet
    • SrcFrmt --- a source code formatter
    • Tooltipper --- a tooltip code generator


    PowerBASIC article in Wikipedia
    Last edited by Tony Burcham; 2 Oct 2008, 10:16 AM. Reason: Code improvement
    TheirCorp's projects at SourceForge

    TheirCorp's website

    sigpic

  • #2
    Format of Bit Values in the SRECT Structure

    Code:
    [COLOR="Blue"][SIZE="4"][B]
    	Format of Bit Values in 
    	the SRECT Structure[/B][/SIZE][B][/B][/COLOR]
    
    [b]The byte sequence from a hex editor:[/b]
    [COLOR="Blue"]78 00 05 DC 00 00 03 E8 00 00 0C 46 00 43 02 FF FF FF 40 06 3F 09 CE 01[/COLOR]
    
    
    [b]Translated to binary (notice they're still in the same order):[/b]
    [COLOR="Blue"]   78        00        05        DC        00        00        03        E8        00     ...
    0111-1000 0000-0000 0000-0101 1101-1100 0000-0000 0000-0000 0000-0011 1110-1000 0000-0000 ...[/COLOR]
    
    
    The high five bits of the first byte (&H78) contain the number of bits occupied
    by each of the four values in the SRECT structure.
    &H78 \ 8 = &H0F or in binary: 0111 1000 \ 8 = 0000 1111 = 15 bits per value.
    This means the SRECT structure occupies [COLOR="Blue"](5 + (4 * 15) + 7) \ 8 = 9 bytes[/COLOR].[list][*] 5 is for the bits that hold the bits-per-value count[*] 4 is the number of elements in the SRECT[*] 15 is the number of bits per value (in this example)[*] 7 is there to cause the result to round upward[*] 8 is the number of bits per byte[/list]
    
    
    [b]Here are the designations of the bits:[/b]
    [COLOR="Blue"]   78        00        05        DC        00        00        03        E8        00
    0111-1000 0000-0000 0000-0101 1101-1100 0000-0000 0000-0000 0000-0011 1110-1000 0000-0000[/COLOR]
    [COLOR="Red"]CCCC CLLL LLLL LLLL LLLL RRRR RRRR RRRR RRRT TTTT TTTT TTTT TTBB BBBB BBBB BBBB BXXX XXXX[/COLOR][list][*] C = Count of bits[*] L = Left (.xMin)[*] R = Right (.xMax)[*] T = Top (.yMin)[*] B = Bottom (.yMax)[*] X = bits to fill the left over space[/list]
    
    
    The proper order of the bits in the final value is exactly the same as they
    appear when viewed in these examples. Using R (Right) as an example, the bits
    below are numbered in their proper order.
    [COLOR="Blue"]...    05        DC        00     ...[/COLOR][b]  byte values[/b]
    [COLOR="Blue"]... 0000-0101 1101-1100 0000-0000 ...[/COLOR][b]  binary values[/b]
    ... LLLL RRRR RRRR RRRR RRRT TTTT ...[b]  bit designations[/b]
    [COLOR="Red"]    XXXX 1111 1987 6543 210X XXXX ...[/COLOR][b]  bit numbers[/b]
    [COLOR="Red"]         4321 0[/COLOR]
    
    
    SRECT.xMax = [COLOR="Blue"]0101 1101-1100 000[/COLOR]
    [COLOR="Red"]             1111 1987 6543 210
                 4321 0[/COLOR]
    
    
    Now, the bits with more normal grouping:
    SRECT.xMax = [COLOR="Blue"]010 1110 1110 0000[/COLOR]
    [COLOR="Red"]             111 1198 7654 3210
                 432 10[/COLOR]
    
    
    So: SRECT.xMax = 010111011100000 = &H2EE0 = 12000 Twips = 600 Pixels
    
    
     What makes it difficult to decode these values, is that Intel processors load
    the bytes in the reverse order that they need to be. The format was apparently
    designed with Motorola CPUs in mind.
    TheirCorp's projects at SourceForge

    TheirCorp's website

    sigpic

    Comment


    • #3
      Flash Info Reader with Compressed File Support

      Flash Info Reader
      by TheirCorp


      This code supports compressed SWF files (the original code doesn't).

      It requires the free zlib1.dll available from: www.zlib.net

      You can find the Flash format (version 9) specification at:
      http://www.adobe.com/devnet/swf/ (1.9 MB)

      For related source code:
      • Gnash - swf movie player
      • SwfDec - a decoder/renderer for Macromedia Flash animations.
      • SwfDotNet - library for writing, reading and generating Flash(tm) Swf files

      The source code ("FlashInfo.bas")
      Code:
      '**************************************
      '	"FlashInfo.bas"
      
      
      'This code has been updated to support compressed
      'SWF files. It requires the free zlib1.dll available
      'from: www.zlib.net
      
      'This file is public domain 2008, by TheirCorp
      '**************************************
      
      #Compile Exe "FlashInfo.exe"
      #Dim All
      
      '**************************************
      
      '%Debug		= 1 'enable/disable debugging code
      
      #If %Def(%Debug)
      #Tools On
      '%ProfileOn		= 1
      
      Global dbg		As Long
      Global dbs		As String
      
      Sub zz()
      
      End Sub 'zz
      
      #Else
      	#Tools Off
      
      #EndIf
      
      '**************************************
      
      $Caption = "TheirCorp's Flash Info Reader"
      
      %GoBtn   = 1001
      %PathTxt = 1101
      %LogTxt  = 1102
      %FileLbl = 1103
      %MsgLbl  = 1104
      
      %LogLines = 8
      '%fo  	  = 10 'output file's number
      Macro fo = 10 'output file's number
      %IsOpen		= 0
      
      Global ghDlg		As Dword
      Global LocalPath	As String   'local path
      
      
      Declare Function GetDroppedFile(ByVal hDrop As Long, fs As String) As Long
      Declare Function ProcessFile(fs As String) As Long
      Declare CallBack Function ShowDlgProc()
      Declare Sub UpdateLog(ps As String)
      
      '**************************************
      
      %SUBDIR				   = 16
      %WINAPI				   = 1
      %WM_USER			   = &H400
      %TRUE				   = 1
      %FALSE				   = 0
      %MAX_PATH			   = 260 ' max. length of full pathname
      %MAX_EXT			   = 256
      
      %WM_DESTROY			   = &H2
      %WM_SETFONT			   = &H30
      %WM_COMMAND			   = &H111
      %WM_DROPFILES		   = &H233
      %WM_NCACTIVATE		   = &H86
      %WM_INITDIALOG		   = &H110
      
      %WS_CHILD			   = &H40000000
      %WS_TABSTOP			   = &H00010000
      %WS_MINIMIZEBOX		   = &H00020000
      %WS_POPUP			   = &H80000000
      %WS_VISIBLE			   = &H10000000
      %WS_CLIPSIBLINGS	   = &H04000000
      %WS_CAPTION			   = &H00C00000 ' WS_BORDER OR WS_DLGFRAME
      %WS_BORDER			   = &H00800000
      %WS_DLGFRAME		   = &H00400000
      %WS_SYSMENU			   = &H00080000
      %WS_VSCROLL			   = &H00200000
      %WS_HSCROLL			   = &H00100000
      
      %WS_EX_LEFT			   = &H00000000
      %WS_EX_LTRREADING	   = &H00000000
      %WS_EX_RIGHTSCROLLBAR  = &H00000000
      %WS_EX_CONTROLPARENT   = &H00010000
      %WS_EX_WINDOWEDGE	   = &H00000100
      %WS_EX_CLIENTEDGE	   = &H00000200
      %WS_EX_ACCEPTFILES	   = &H00000010
      %WS_EX_TOOLWINDOW	   = &H00000080
      
      %HWND_DESKTOP			   = 0
      
      %BN_CLICKED				   = 0
      %BS_TEXT				   = &H0&
      %BS_PUSHBUTTON			   = &H0&
      %BS_GROUPBOX			   = &H7&
      %BS_CENTER				   = &H300&
      %BS_TOP					   = &H400&
      %BS_VCENTER				   = &HC00&
      %BS_DEFPUSHBUTTON		   = &H1&
      %BS_ICON				   = &H40&
      %BS_BITMAP				   = &H80&
      
      %DM_SETDEFID			   = %WM_USER + 1
      
      %DS_3DLOOK				   = &H0004&
      %DS_MODALFRAME			   = &H0080& ' Can be combined with WS_CAPTION
      %DS_NOFAILCREATE		   = &H0010&
      %DS_SETFONT				   = &H0040& ' User specified font for Dlg controls
      %DS_SETFOREGROUND		   = &H0200& ' not in win3.1
      
      %ES_LEFT		 = &H0&
      %ES_MULTILINE	 = &H4&
      %ES_AUTOVSCROLL  = &H40&
      %ES_AUTOHSCROLL  = &H80&
      %ES_WANTRETURN   = &H1000&
      
      %EM_SCROLL		 = &HB5
      %EM_SCROLLCARET  = &HB7
      %EM_SETSEL		 = &HB1
      
      %SS_CENTER					  = &H00000001
      %SS_RIGHT					  = &H00000002
      
      
      '**************************************
      ' for zlib1.dll
      
      %Z_OK		= 0
      %Z_FINISH	= 4
      
      Type zstream 'Dword
      	next_in		As Byte Ptr		' next input byte
      	avail_in	As Long			' number of bytes available at next_in
      	total_in	As Dword		' total nb of input bytes read so far
      	next_out	As Byte Ptr		' next output byte should be put there
      	avail_out	As Long			' remaining free space at next_out
      	total_out	As Dword		' total nb of bytes output so far
      	msg      	As Asciz Ptr	' last error message, NULL if no error
      	internal_state As Dword		' not visible by applications
      	alloc_func	As Dword		' used to allocate the internal state
      	free_func	As Dword		' used to free the internal state
      	voidpf		As Dword		' private data object passed to zalloc and zfree
      	data_type	As Long			' best guess about the data type: binary or text
      	adler		As Dword		' adler32 value of the uncompressed data
      	reserved	As Dword		' reserved For future use
      End Type
      
      
      '**************************************
      '	Declares
      '**************************************
      
      Declare Function GetModuleFileName Lib "KERNEL32.DLL" Alias "GetModuleFileNameA" (ByVal hModule As Dword, lpFileName As Asciiz, ByVal nSize As Dword) As Dword
      Declare Sub DragAcceptFiles Lib "SHELL32.DLL" Alias "DragAcceptFiles" (ByVal hwnd As Dword, ByVal fAccept As Long)
      Declare Sub DragFinish Lib "SHELL32.DLL" Alias "DragFinish" (ByVal hDrop As Dword)
      Declare Function DragQueryFile Lib "SHELL32.DLL" Alias "DragQueryFileA" (ByVal hDrop As Dword, ByVal uiFile As Dword, lpStr As Asciiz, ByVal cch As Dword) As Dword
      
      Declare Function GetFocus Lib "USER32.DLL" Alias "GetFocus" () As Dword
      Declare Function SetFocus Lib "USER32.DLL" Alias "SetFocus" (ByVal hWnd As Dword) As Long
      
      Declare Function inflateInit Lib "zlib1.dll" Alias "inflateInit_"(ByRef zstr As zstream, ByRef ver As Asciz * 8, ByVal szZstream As Long) As Long
      Declare Function inflate Lib "zlib1.dll" Alias "inflate"(strm As zstream, ByVal fFlush As Long) As Long
      
      'Declare Function inflateInit CDecl Lib "zlib1.dll" Alias "inflateInit_"(ByRef zstr As zstream, ByRef ver As Asciz * 8, ByVal szZstream As Long) As Long
      'Declare Function inflate CDecl Lib "zlib1.dll" Alias "inflate"(strm As zstream, ByVal fFlush As Long) As Long
      
      '**************************************
      
      ' Tag values that represent actions or data in a Flash script.
      %End					= 0
      %ShowFrame				= 1
      %DefineShape			= 2
      %FreeCharacter			= 3
      %PlaceObject			= 4
      %RemoveObject			= 5
      %DefineBits				= 6
      %DefineButton			= 7
      %JPEGTables				= 8
      %SetBackgroundColor		= 9
      %DefineFont				= 10
      %DefineText				= 11
      %DoAction				= 12
      %DefineFontInfo			= 13
      %DefineSound			= 14 ' Event sound tags.
      %StartSound				= 15
      '	16
      %DefineButtonSound		= 17
      %SoundStreamHead		= 18
      %SoundStreamBlock		= 19
      %DefineBitsLossless		= 20 ' A bitmap using lossless zlib compression.
      %DefineBitsJPEG2		= 21 ' A bitmap using an internal JPEG compression table.
      %DefineShape2			= 22
      %DefineButtonCxform		= 23
      %Protect				= 24 ' This file should not be importable for editing.
      '	25
      ' These are the new tags for Flash 3.
      %PlaceObject2			= 26 ' The new style place w/ alpha color transform and name.
      '	27
      %RemoveObject2			= 28 ' A more compact remove object that omits the character tag (just depth).
      '	29 - 31
      %DefineShape3			= 32 ' A shape V3 includes alpha values.
      %DefineText2			= 33 ' A text V2 includes alpha values.
      %DefineButton2			= 34 ' A button V2 includes color transform, alpha and multiple actions
      %DefineBitsJPEG3		= 35 ' A JPEG bitmap with alpha info.
      %DefineBitsLossless2	= 36 ' A lossless bitmap with alpha info.
      %DefineEditText			= 37 ' An editable Text Field
      '	38
      %DefineSprite			= 39 ' Define a sequence of tags that describe the behavior of a sprite.
      %NameCharacter			= 40 ' Name a character definition, character id and a string, (used for buttons, bitmaps, sprites and sounds).
      '	41 - 42
      %FrameLabel				= 43 ' A string label for the current frame.
      '	44
      %SoundStreamHead2		= 45 ' For lossless streaming sound, should not have needed this...
      %DefineMorphShape		= 46 ' A morph shape definition
      '	47
      %DefineFont2			= 48 '
      
      'Some even newer tags...
      ' 49 - 55
      %ExportAssets				= 56
      %ImportAssets				= 57
      %EnableDebugger				= 58
      %DoInitAction				= 59
      %DefineVideoStream			= 60
      %VideoFrame					= 61
      %DefineFontInfo2			= 62
      ' 63
      %EnableDebugger2			= 64
      %ScriptLimits				= 65
      %SetTabIndex				= 66
      ' 67 - 68
      %FileAttributes				= 69
      %PlaceObject3				= 70
      %ImportAssets2				= 71
      ' 72
      %DefineFontAlignZones		= 73
      %CSMTextSettings			= 74
      %DefineFont3				= 75
      %SymbolClass				= 76
      %MetaData					= 77
      %DefineScalingGrid			= 78
      ' 79 - 81
      %DoABC						= 82
      %DefineShape4				= 83
      %DefineMorphShape2			= 84
      ' 85
      %DefineSceneAndFrameLabelData	= 86
      %DefineBinaryData			= 87
      %DefineFontName				= 88
      %StartSound2				= 89
      
      '**************************************
      
      'the FlashHeader size is variable beyond the "nLen"
      'element, so that portion is REMed out
      Type FlashHeader
      	Sig		As String * 3 ' = "FWS" ("SWF" backward)
      	Ver		As Byte 'flash version
      	nLen	As Dword 'file length in bytes
      	'zFram	As SRECT 'frame size in TWIPS
      	'nRate	As Word 'frame delay in 8.8 fixed number of frames per second
      	'nFram	As Word 'total number of frames in movie
      End Type 'FlashHeader
      
      
      'the SRECT structure in a SWF file is composed of variable-
      'length bit fields. this "TRECT" structure is being used
      'to store the values after retrieving them from an SRECT
      Type TRECT
      	xMin	As Long
      	xMax	As Long
      	yMin	As Long
      	yMax	As Long
      End Type
      
      
      'short header
      '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
      '	|               |               |               |               |
      '	| 15  14  13  12| 11  10  9   8 | 7   6   5   4 | 3   2   1   0 |
      '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
      '	|   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |
      '	|                                       |                       |
      '	|              Tag                      |     Length            |
      '	|                                       |                       |
      '	|   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |
      '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
      
      
      'long header
      '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
      '	|               |               |               |               |
      '	| 15  14  13  12| 11  10  9   8 | 7   6   5   4 | 3   2   1   0 |
      '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
      '	|   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |
      '	|                                       |                       |
      '	|              Tag                      |        &H3F           |
      '	|                                       |                       |
      '	|   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |   |
      '	+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
      '...followed by a Dword length value
      
      
      '**************************************
      
      Function InflateStrm(ps As String, ByVal nLen As Long) As Long
      Local n			As Long
      Local r			As Long
      Local zstrm		As zstream
      Local os		As String 'out data
      
      	n = nLen
      	os = String$(n, $Nul)
      
      	zstrm.avail_in = Len(ps)
      	zstrm.avail_out = n
      	zstrm.next_in = StrPtr(ps)
      	zstrm.next_out = StrPtr(os)
      
      	r = inflateInit(zstrm, "1.2.1", SizeOf(zstrm))
      
      	If r = %Z_OK Then
      		n = inflate(zstrm, %Z_FINISH)
      		If n => 0 Then
      			ps = Left$(os, zstrm.total_out)
      			Function = n
      		End If
      	End If
      
      End Function 'InflateStrm
      
      '**************************************
      
      Global q		As Quad
      Global Byt()	As Byte
      Global Dwd()	As Dword
      Global rct		As TRECT
      
      '**************************************
      
      'Using Static variables eliminates the need for
      'creating them on the stack
      
      '"Byt()" and "Dwd()" are Globals, so they can be
      'DIMed from inside DeFlash
      
      '"q" and "rct" are Globals, so they don't have to
      'be passed as parameters
      
      Function ReadRect(ps As String) As Long
      #Register All
      Static p		As Byte 'offset into ps
      Static nBits	As Byte 'number of bits per value
      Static iBit		As Byte 'index of value's first bit
      Static nExtra	As Byte 'count of extra trailing bits
      Static iField	As Byte 'index for Dwd()
      
      Static iSign	As Byte 'index of the sign-bit
      Static fSign	As Dword 'holds the sign extension bits
      Static bSign	As Dword '2 ^ nBits for extending a negative sign
      Static fMask	As Dword 'to mask out trailing bits
      
      
      'for swapping bytes in Byt()
      Static iByte	As Byte 'index of byte containing valid bits
      Static iMax		As Byte 'index of byte containing valid bits
      
      
      	'get the number of bits per value (equivalent of: nBits = Asc(ps) \ 8)
      	nBits = Asc(ps)
      	Shift Right nBits, 3
      
      	'sign-extension masks
      	iSign = nBits - 1 'index of the sign-bit
      	bSign = 1 : Shift Left bSign, nBits ' bSign = (2 ^ nBits)... mask for sign extension
      
      	fMask = bSign - 1 'mask to remove extra high bits
      
      	fSign = Not fMask 'mask to add negative sign bits
      
      	nExtra = 5 ' count of extra bits
      	iBit = 5 'index of first bit of current value
      
      	For iField = 0 To 3
      
      		p = (iBit \ 8) + 1 'offset to the first byte of the bit value to retrieve
      
      		q = Cvq(ps, p) 'Load a Quad full of bits
      
      		'Swap all valid bytes to convert it to big-endian (Byt() is DIMed on top of q)
      		iByte = 0
      		iMax = (8 - nExtra + nBits) \ 8
      		Do Until iByte => iMax
      			Swap Byt(iByte), Byt(iMax)
      			Incr iByte
      			Decr iMax
      		Loop
      
      		nExtra = (8 - ((iBit + nBits) And 7)) And 7 'count of trailing (extra) bits
      		Shift Right q, nExtra 'Shift out the trailing (extra) bits
      
      		Dwd(iField) = q 'Store in Dword (it's DIMed on top of a TRECT field)
      
      		Dwd(iField) = Dwd(iField) And fMask 'Mask out extra high bits
      
      		'Extend the sign bit, if needed
      		If Bit(Dwd(iField), iSign) Then Dwd(iField) = Dwd(iField) Or fSign
      
      		'advance to the first bit of the next value (zero-based)
      		iBit = iBit + nBits
      
      	Next iField
      
      	'Function = 1 'success
      
      End Function 'ReadRect
      
      '**************************************
      
      Function DeFlash(fs As String) As Long
      #Register All
      Local ff		As Long
      Local n			As Long
      Local p			As Long
      Local cnt		As Long
      Local nLen		As Long
      Local vTag		As Long
      Local FlsHdr	As FlashHeader
      Local cs		As String
      Local ls		As String
      
      Data "End"
      Data "Show Frame"
      Data "Define Shape"
      Data "Free Character"
      Data "Place Object"
      Data "Remove Object"
      Data "Define Bits"
      Data "Define Button"
      Data "JPEG Tables"
      Data "Set Background Color"
      Data "Define Font"
      Data "Define Text"
      Data "Do Action"
      Data "Define Font Info"
      Data "Define Sound"
      Data "Start Sound"
      Data
      Data "Define Button Sound"
      Data "Sound Stream Head"
      Data "Sound Stream Block"
      Data "Define Bits Lossless"
      Data "Define Bits JPEG2"
      Data "Define Shape2"
      Data "Define Button CX Form"
      Data "Protect"
      Data
      Data "Place Object 2"
      Data
      Data "Remove Object 2"
      Data ,,
      Data "Define Shape 3"
      Data "Define Text 2"
      Data "Define Button 2"
      Data "Define Bits JPEG 3"
      Data "Define Bits Lossless 2"
      Data "Define Edit Text"
      Data
      Data "Define Sprite"
      Data "Name Character"
      Data ,
      Data "Frame Label"
      Data
      Data "Sound Stream Head 2"
      Data "Define Morph Shape"
      Data
      Data "Define Font 2"
      '	49 - 55
      Data ,,,,,,
      Data "ExportAssets"
      Data "ImportAssets"
      Data "EnableDebugger"
      Data "DoInitAction"
      Data "DefineVideoStream"
      Data "VideoFrame"
      Data "DefineFontInfo2"
      '	63
      Data
      Data "EnableDebugger2"
      Data "ScriptLimits"
      Data "SetTabIndex"
      '	67 - 68
      Data ,
      Data "FileAttributes"
      Data "PlaceObject3"
      Data "ImportAssets2"
      '	72
      Data
      Data "DefineFontAlignZones"
      Data "CSMTextSettings"
      Data "DefineFont3"
      Data "SymbolClass"
      Data "MetaData"
      Data "DefineScalingGrid"
      '	79 - 81
      Data ,,
      Data "DoABC"
      Data "DefineShape4"
      Data "DefineMorphShape2"
      '	85
      Data
      Data "DefineSceneAndFrameLabelData"
      Data "DefineBinaryData"
      Data "DefineFontName"
      Data "StartSound2"
      
      
      	'--------------------------------------
      	'open the file and get the flash header
      	If Len(Dir$(fs)) Then
      		Try
      			ff = FreeFile
      			Open fs For Binary Access Read Lock Shared As #ff
      			Get #ff, , FlsHdr
      		Catch
      			UpdateLog "Error opening file: " & fs
      			Exit Function
      		End Try
      	Else
      		UpdateLog "Couldn't find: " & fs
      	End If
      
      
      	' "FWS" = normal, uncompressed
      	' "CWS" = beyond the eighth byte is compressed with z-lib
      	If FlsHdr.Sig = "CWS" Then
      
      		Get$ #ff, Lof(ff), cs 'it's already at position 9
      
      		If InflateStrm(cs, FlsHdr.nLen) = 0 Then
      			UpdateLog "Decompression failed"
      			Exit Function
      		End If
      
      	ElseIf FlsHdr.Sig = "FWS" Then
      		Get$ #ff, Lof(ff), cs 'it's already at position 9
      
      	Else
      		UpdateLog "Unrecognized format"
      		Close# ff
      		Exit Function
      	End If
      
      	Close# ff
      
      	UpdateLog "Processing..."
      
      	'--------------------------------------
      	'open an output file
      	Try
      		ls = Mid$(fs, InStr(-1, fs, "\") + 1)
      		ls = MCase$(Extract$(ls, ".")) & ".txt"
      		Open LocalPath & "\" & ls For Output As fo
      		UpdateLog "Output file: " & ls
      	Catch
      		UpdateLog "Error opening output file: " & ls
      		Exit Function
      	End Try
      
      
      	Dim Dwd(4)	As Dword At VarPtr(rct) 'place Dword array on top of the TRECT structure
      	Dim Byt(8)	As Byte At VarPtr(q)	'place Byte array on top of "q" (a Quad variable)
      
      	Print# fo,
      	Print# fo, "File: "; Mid$(fs, Instr(-1, fs, "\") + 1)
      	Print# fo,
      	Print# fo, "Signature:		"; FlsHdr.Sig
      	Print# fo, "Flash version:	"; Format$(FlsHdr.Ver)
      	Print# fo, "File length:	"; Format$(FlsHdr.nLen)
      
      	ReadRect(Left$(cs, 32)) 'give it at least eight extra bytes
      	Print# fo,
      	Print# fo, "Frame dimensions (Twips, Pixels)"
      	Print# fo, "	Left:	"; Format$(rct.xMin);   ",	"; Format$(rct.xMin\20)
      	Print# fo, "	Top:	"; Format$(rct.yMin);    ",	"; Format$(rct.yMin\20)
      	Print# fo, "	Right:	"; Format$(rct.xMax);  ",	"; Format$(rct.xMax\20)
      	Print# fo, "	Bottom:	"; Format$(rct.yMax); ",	"; Format$(rct.yMax\20)
      	Print# fo,
      
      	'go past frame dimensions
      	p = 1 + ((12 + ((Asc(cs, 1) \ 8) * 4)) \ 8)	' = 1 + (5 + 7 + ((Asc(cs, 1) \ 8) * 4)) \ 8)
      
      	Print# fo,
      	Print# fo, "Frame rate:	"; Format$(Asc(cs, p + 1)); "."; Format$(Asc(cs, p))
      
      	p = p + 2
      	Print# fo, "Frame count:	" Format$(CvWrd(cs, p))
      
      	p = p + 2
      	Print# fo,
      	Print# fo, "------------------------------------------"
      	Print# fo, "Tag				Tag"
      	Print# fo, "Code	Length	Type"
      	Print# fo, "------------------------------------------"
      	Do While p < Len(cs)
      
      		nLen = CvWrd(cs, p)
      		p = p + 2
      
      		vTag = nLen
      		Shift Right vTag, 6
      		nLen = nLen And &H03F
      
      		If nLen = &H03F Then 'long header
      			nLen = CvDwd(cs, p)
      			p = p + 4
      		End If
      
      		Print# fo, Format$(vTag); ",		"; Format$(nLen); ",		";  Read$(vTag + 1)
      
      		p = p + nLen
      		Incr cnt
      
      	Loop While p > 0
      
      	'Function =
      
      End Function 'DeFlash
      
      '**************************************
      
      Sub UpdateLog(ps As String)
      Static ct   As Long
      Static ls   As String
      Static ts   As String
      
      	If Len(Command$) Then
      		'MsgBox ps
      
      	Else
      		Incr ct
      
      		If Len(ps) Then
      			'Control Get Text ghDlg, %LogTxt To ls
      			'Dialog DoEvents
      			ps = ps & $CrLf
      		Else
      			ct = 1
      			ls = ""
      			ts = ""
      		End If
      
      		If ct > %LogLines Then ts = Remain$(ts, $CrLf) & ps
      		ls = ls & ps
      
      		If Left$(ps, 5) = "Ready" Then
      			Control Set Text ghDlg, %LogTxt, LTrim$(Left$(ls, 32000), Any $CrLf)
      			Dialog DoEvents
      			Control Send ghDlg, %LogTxt, %EM_SETSEL, 65536, 65536
      			Dialog DoEvents
      			Control Send ghDlg, %LogTxt, %EM_SCROLLCARET, 0, 0
      			Dialog DoEvents
      		Else
      			Control Set Text ghDlg, %LogTxt, ts
      		End If
      
      	End If
      
      End Sub 'UpdateLog
      
      '**************************************
      'returns %true, if any files were received
      Function GetDroppedFile(ByVal hDrop As Long, fs As String) As Long
      Local ct  As Dword
      Local az  As Asciiz * %MAX_PATH
      
      	ct = DragQueryFile(hDrop, &HFFFFFFFF&, "", ByVal 0&)
      
      	If ct > 0 Then
      		az = Space$(%MAX_PATH)
      		ct = DragQueryFile(hDrop, 0, az, Len(az) - 1)
      		fs = Left$(az, ct)
      		Function = %True
      	End If
      
      End Function
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      'expects "fs" to contain the path and name
      Function ProcessFile(fs As String) As Long
      
      	DeFlash(fs)
      	If FileAttr(fo, %IsOpen) Then Close# fo
      
      End Function 'ProcessFile
      
      '**************************************
      
      CallBack Function ShowDlgProc()
      Local  fs   As String
      
      #If %Def(%ProfileOn)
      	Profile "Profile.txt"
      #EndIf
      
      	Select Case As Long CbMsg
      
      		'Case %WM_INITDIALOG
      
      		Case %WM_NCACTIVATE
      			Static hWndSaveFocus  As Dword
      			If IsFalse CbWParam Then
      				hWndSaveFocus = GetFocus()
      			ElseIf hWndSaveFocus Then
      				SetFocus(hWndSaveFocus)
      				hWndSaveFocus = 0
      			End If
      
      		Case %WM_DROPFILES
      			If (GetDroppedFile(CbWParam, fs)) Then
      				Control Set Text ghDlg, %PathTxt, fs
      			End If
      			DragFinish CbWParam
      
      		Case %WM_COMMAND
      			Select Case As Long CbCtl
      				Case %GoBtn
      					If CbCtlMsg = %BN_CLICKED Or CbCtlMsg = 1 Then
      						Control Get Text ghDlg, %PathTxt To fs
      						UpdateLog ""
      						ProcessFile(fs)
      						UpdateLog "Ready..."
      					End If
      			End Select
      
      	End Select
      
      End Function
      
      '**************************************
      
      Function PBMain() As Long
      Local lRslt As Long
      
      #If %Def(%ProfileOn)
      	Profile "Profile.txt"
      #EndIf
      
      	'get and save the local path without a trailing backslash
      	LocalPath = String$(%MAX_PATH, $Nul)
      	GetModuleFileName(ByVal 0, ByVal StrPtr(LocalPath), %MAX_PATH)
      	LocalPath = Left$(LocalPath, InStr(-1, LocalPath, "\") - 1)
      
      
      	If Len(Command$) Then
      
      		ProcessFile(Command$)
      		MsgBox "Done"
      
      	Else
      
      		Dialog New %HWND_DESKTOP, $Caption, , , 256, 138, %WS_POPUP Or %WS_BORDER _
      			Or %WS_DLGFRAME Or %WS_CAPTION Or %WS_SYSMENU Or %WS_MINIMIZEBOX Or _
      			%WS_VISIBLE Or %DS_MODALFRAME Or %DS_SETFOREGROUND Or %DS_3DLOOK Or _
      			%DS_NOFAILCREATE Or %DS_SETFONT, %WS_EX_WINDOWEDGE Or _
      			%WS_EX_ACCEPTFILES Or %WS_EX_CONTROLPARENT Or %WS_EX_LEFT Or _
      			%WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR, To ghDlg
      
      		Control Add Label,   ghDlg, %FileLbl, "&File:", 0, 4, 19, 10, %WS_CHILD Or _
      			%WS_VISIBLE Or %WS_TABSTOP Or %SS_RIGHT, %WS_EX_LEFT Or %WS_EX_LTRREADING
      
      		Control Add TextBox, ghDlg, %PathTxt, "", 20, 2, 233, 12
      
      		Control Add Button,  ghDlg, %GoBtn, "&Go", 220, 17, 32, 14, %WS_CHILD Or _
      			%WS_VISIBLE Or %WS_BORDER Or %WS_TABSTOP Or %BS_TEXT Or _
      			%BS_DEFPUSHBUTTON Or %BS_PUSHBUTTON Or %BS_CENTER Or %BS_VCENTER, _
      			%WS_EX_LEFT Or %WS_EX_LTRREADING
      
      		Control Add Label, ghDlg, %MsgLbl, "&Messages:", 2, 22, 39, 10
      
      		Control Add TextBox, ghDlg, %LogTxt, "", 2, 34, 252, 100, %WS_CHILD Or _
      			%WS_VISIBLE Or %WS_TABSTOP Or %WS_HSCROLL Or %WS_VSCROLL Or %ES_LEFT _
      			Or %ES_MULTILINE Or %ES_AUTOHSCROLL Or %ES_AUTOVSCROLL Or %ES_WANTRETURN, _
      			%WS_EX_CLIENTEDGE Or %WS_EX_LEFT Or %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR
      
      		Dialog Send ghDlg, %DM_SETDEFID, %GoBtn, 0
      		Control Set Focus ghDlg, %PathTxt
      
      		DragAcceptFiles ghDlg, %True 'Register window to accept dropped files.
      
      		Dialog Show Modal ghDlg, Call ShowDlgProc To lRslt
      
      		Function = lRslt
      
      	End If
      
      End Function
      
      '**************************************

      • TheirCorp's SourceForge project
        includes:
      • API Helper --- a code generator for the Win32 API
      • BinEditPlus --- a decompiler and more
      • ComHelper --- a code generator for the COM programming
      • "Flex" --- an editor with novel features
      • GDI Debug --- catches programming errors that could lead
        to resource leaks
      • Import Monitor --- (an API hook) Intercepts and monitors
        calls to imported functions
      • Intricately Mergeable Templates
      • Jellyfish Pro enhancer plugin (adds drag-and-drop and more..)
      • TheirEdit --- an editor for PowerBASIC code
      • TheirNote --- a KeyNote clone
      • TheirSheet --- a spreadsheet
      • SrcFrmt --- a source code formatter
      • Tooltipper --- a tooltip code generator


      PowerBASIC article in Wikipedia
      Last edited by Tony Burcham; 1 Oct 2008, 10:16 PM. Reason: Fixed bug.
      TheirCorp's projects at SourceForge

      TheirCorp's website

      sigpic

      Comment

      Working...
      X