' Extract_Post_from_srf rev2a.bas - Simon Crombie <simoncrombie@onetel.com>

' Script to extract a data file from a Surfer plot file Post Map or Classed Post Map

' Data will be output in a comma separated ASCII file with the extension csv

' Notes:
' 1. This script will only output the first postmap found in a srf file
'    To extract a postmap which is not the first the easiest option is to break it
'    apart from any overlay into a separate map, delete all other maps and save it
'    as a new srf file, then extract from the new srf file

' 2. Where a postmap data file has columns which are not completely filled this
'		 script may not work properly. In some instances it is possible to identify a
'    format byte indicating a blank value but if the postmap was generated from an
'    Excel spreadsheet, especially if there are completely blank columns, this may
'    not apply. Data in columns before the blank or incomplete column will be
'    extracted normally.

' 3. The script reads the entire srf file into memory in order to find the postmap tag,
'		 as this is literally millions of times faster than stepping through the disk
'		 file and checking bytes. In the case of large srf files and limited memory
'    the safest option would be to create a new srf file containing just the post map.


' Declare type PostMap for holding postmap header values
	Type PostMap
		start_byte As Long
		object_id_len As Byte
		object_id As String
		num_rows As Long
		num_cols As Long
		file_name_len As Byte
		full_file_name As String
		file_stem As String
	End Type
Sub Main
	' Get name of srf file to extract data from
	Dim srfInFile As String
	Dim InFileDir As String
	srfInFile = GetFilePath(,"srf",,"Select srf file to extract data from",0)
	If srfInFile = "" Then
		Debug.Print "No file name entered. Programme exiting..."
		MsgBox("No Surfer Plot file name entered. Programme exiting...", _
			vbExclamation, "Warning")
		End
	End If

	Debug.Print vbCrLf; vbCrLf; "STARTING PROCESSING OF ";  srfInFile; vbCrLf; _
		"=======================================";Time;"======================================="

	' Extract directory of surfer srf file
	InFileDir = Left$(srfInFile,InStrRev(srfInFile,"\"))
	' Debug.Print InFileDir

	' Open srf file as binary file
	Open srfInFile For Binary As #1

	InFileLen = FileLen(srfInFile)

	'Create a byte array of the length of the entire file and read in the file
	ReDim FileInMemory(1 To InFileLen) As Byte
	Get #1, 1, FileInMemory

	'Create a variable of type postmap to hold the header information
	Dim OutPostMap As PostMap

	'Convert binary file into a long string in order to search for postmap tag
	Dim strFileInMemory As String
	strFileInMemory = StrConv(FileInMemory,vbUnicode )
	OutPostMap.start_byte = InStr(strFileInMemory,"DL_PostMap")

	If InStr(strFileInMemory,"DL_PostMap") = 0 Then
		MsgBox("No Post Maps found. Programme exiting...",vbInformation, "No Post Maps")
		End
	Else
		Debug.Print "Found post map tag at byte loc: "; OutPostMap.start_byte
	End If

	'Clear memory occupied by long string variable
	strFileInMemory = ""
	ReDim FileInMemory(1) As Byte

	' Set up variables for searching for postmap tag
	Dim FilePointer As Long
	Dim defDir As String
	Dim k As Long
	Dim i As Long
	Dim j As Long
	Dim inByte As Byte
	Dim stringByte As Byte
	Dim stringData As String*255
	Dim numericData As Double
	Dim colStringDataLoc As Long
	Dim numStringBytes As Long
	i = 1
	j = 0


	' Extract information about the post map data
	FilePointer = OutPostMap.start_byte + 14
	Seek #1, FilePointer ' Offset pointer 14 bytes from start of DL tag
	Get #1, ,OutPostMap.object_id_len 'Read length of Object ID string, if present
	If OutPostMap.object_id_len <> 0 Then
			'Create byte array of correct length to read Object ID
		ReDim byteString(OutPostMap.object_id_len) As Byte
			' Read Object ID
		Get #1, , byteString
			' Convert byte array to string
		OutPostMap.object_id = StrConv$(byteString, vbUnicode)
		Debug.Print "Object ID: "; OutPostMap.object_id
			'Increment object_id_len to be used later for calculating offsets
		OutPostMap.object_id_len = OutPostMap.object_id_len + 1
	End If
		' Debug.Print outpostmap.object_id_len
		'Advance pointer over bytes of unknown purpose to read num_rows and num_cols
	FilePointer = Seek(1) + 28
	Seek #1, FilePointer
	Get #1, , OutPostMap.num_rows
	OutPostMap.num_rows = OutPostMap.num_rows + 1
	Get #1, , OutPostMap.num_cols
	Get #1, , OutPostMap.file_name_len 'Read length of Postmap file name
		'Create byte array of correct length to read file path
	ReDim byteString(OutPostMap.file_name_len) As Byte
	Get #1, , byteString
		' Convert byte array to string
	OutPostMap.full_file_name = StrConv$(byteString, vbUnicode)
		' Debug.Print outpostmap.full_file_name
		' Extract file name from full file path
	OutPostMap.file_stem = Right$(OutPostMap.full_file_name, _
		(Len(OutPostMap.full_file_name)-InStrRev(OutPostMap.full_file_name,"\")))
	OutPostMap.file_stem = Left$(OutPostMap.file_stem, _
		InStrRev(OutPostMap.file_stem,".")-1)
	Debug.Print OutPostMap.num_rows; " rows, "; OutPostMap.num_cols; _
		" cols, File name: "; OutPostMap.full_file_name; _
		", Start Byte: "; OutPostMap.start_byte



	' Test if file path exists on user's computer
	On Error Resume Next 'Turn off error reporting.
	defDir = Left$(OutPostMap.full_file_name, InStrRev(OutPostMap.full_file_name,"\")-1)
	If Err.Number<>0 Then
		defDir = CurDir$()
	End If

	On Error GoTo 0 'Turn on error reporting.



		' Ask for name of extracted data file -
		' use original file name as default and original directory if exists
	Dim OutDatFileName As String
	OutPostMap.file_stem = OutPostMap.file_stem & ".csv"
		' Debug.Print defDir
	OutDatFileName = GetFilePath(OutPostMap.file_stem, ,defDir, _
		"Name for output data file",3)
	If OutDatFileName = "" Then
		Debug.Print "No file name entered. Programme exiting..."
		End
	End If


	' Set up 2D string array to hold extracted data values - numeric values
	'	will be converted to text
	ReDim data_array(OutPostMap.num_rows, OutPostMap.num_cols) As String
	FilePointer = OutPostMap.start_byte + OutPostMap.object_id_len + 52 + _
		OutPostMap.file_name_len + 28 'Find data for first column
	Seek #1, FilePointer
	Debug.Print "Start of data at byte: "; FilePointer

	For i = 1 To OutPostMap.num_cols
			'Calculate location of text data for a non-numerical column
		colStringDataLoc = Seek(1) + 9 * OutPostMap.num_rows
			'Variable to keep count of total number of text bytes for the column
		numStringBytes = 0
			'Debug.Print " String data located at byte: "; colStringDataLoc
		For j = 1 To OutPostMap.num_rows
			' Read data format byte
			Get #1, , inByte
			'Debug.Print inByte
			If inByte = 1 Then ' for a numeric value
				Get #1, ,numericData 'Read 8 bytes - 64bit fp number
				FilePointer = Seek(1)
				data_array(j,i) = CStr(numericData)
			ElseIf inByte = 2 Then ' for a text value
					'Read a long integer which gives offset from colStringDataLoc
					'	for the text data
				Get #1, , k
					'Debug.Print k
					' Remember file location to be able to get back after reading text
				FilePointer = Seek(1) + 4
					' Read 255 bytes of which text field will be up to first zero byte
				Get#1, k + colStringDataLoc, stringData
					' Extract text up to first zero byte
				data_array(j,i) = Left$(stringData, InStr(stringData, Chr$(0))-1)
					' Increment number of text bytes
				numStringBytes = numStringBytes + InStr(stringData, Chr$(0))
					' Advance four more bytes to get to format byte for next value
				Seek #1, FilePointer
			ElseIf inByte = 0 Then ' for a blank field
				FilePointer = Seek(1) + 8
				Seek #1, FilePointer ' Advance to next data value
				data_array(j,i) = ""
			End If
			' Debug.Print j; ": "; data_array(j,i)
		Next j
			' Debug.Print Seek(1)
			' Debug.Print "Total no of string bytes: "; numStringBytes
			'Set pointer to start of data values for next column
		Seek #1, FilePointer + numStringBytes + 28
		Debug.Print "Finished with column "; i; " - now moving to byte: "; Seek(1)
	Next i



	' Output the array into a csv file
	Open OutDatFileName For Output As #2
	For i = 1 To OutPostMap.num_rows
		For j = 1 To OutPostMap.num_cols
			Print #2, data_array(i,j);
			If j <> OutPostMap.num_cols Then
				Print #2, ",";
			Else
				Print #2,
			End If
		Next j
	Next i

	Close #1
	Close #2

	Debug.Print
	Debug.Print "=======================================Finished======================================="
	Debug.Print "                                       ";Time;"                                       " + vbCrLf + vbCrLf

End Sub