Read Shape Format

Just starting out? Need help? Post your questions and find answers here.
Post Reply
Tietze
New User
New User
Posts: 2
Joined: Thu Sep 04, 2003 2:50 pm

Read Shape Format

Post by Tietze »

Hello,

I have a problem to read the shapeformat with purebaisc. The specification is here:

http://www.esri.com/library/whitepapers ... pefile.pdf

To read integer type variables is no problem:

long.l = ReadLong()
test.s=str(long.l)

But how could I read the double type variables? Could you give me a short code example? I only need the "Little" byte order Format.

Thanks for your help....

Greetings from Kiel....

Tietze
Top
freak
PureBasic Team
PureBasic Team
Posts: 5948
Joined: Fri Apr 25, 2003 5:21 pm
Location: Germany

Post by freak »

Assuming, that by Double, you mean 64bit integers,
this might be usefull:

Code: Select all

Structure d 
  lowLONG.l 
  hiLONG.l 
EndStructure 

Procedure.s StrD(*value.d) 
  Protected buffer1.s, buffer2.s, buffer3.s, pos1.l, pos2.l, pos3.l, calc1.l, calc2.l 
  buffer3 = StrU(*value\lowLONG,#LONG) 
  For pos1 = Len(StrU(*value\hiLONG,#LONG)) To 1 Step -1 
    For pos2 = Len(StrU(-1,#LONG)) To 1 Step -1 
      calc1 = Val(Mid(StrU(*value\hiLONG,#LONG),pos1,1)) * Val(Mid(StrU(-1,#LONG),pos2,1)) 
      calc2 = (Len(StrU(*value\hiLONG,#LONG))-pos1)+(Len(StrU(-1,#LONG))-pos2) 
      buffer1 = Str(calc1) + Left("00000000000000000000",calc2) 
      buffer2 = buffer3 
      buffer3 = "" 
      calc1 = 0 
      If Len(buffer1) > Len(buffer2) 
        buffer2 = Right("00000000000000000000"+buffer2,Len(buffer1)) 
      Else 
        buffer1 = Right("00000000000000000000"+buffer1,Len(buffer2)) 
      EndIf 
      For pos3 = Len(buffer1) To 1 Step -1 
        calc1 + Val(Mid(buffer1,pos3,1)) + Val(Mid(buffer2,pos3,1)) 
        buffer3 = Right(Str(calc1),1)+buffer3 
        calc1/10 
      Next pos3 
      If calc1 > 0: buffer3 = Str(calc1)+buffer3: EndIf 
    Next pos2 
  Next pos1 
  While Left(buffer3,1)="0" 
    buffer3 = Right(buffer3, Len(buffer3)-1) 
  Wend 
  ProcedureReturn buffer3 
EndProcedure
Here is how you can use that then:

Code: Select all

value.d
ReadData(@value, 8)
test.s = StrD(@value)
Timo
quidquid Latine dictum sit altum videtur
Top
Pupil
Enthusiast
Enthusiast
Posts: 715
Joined: Fri Apr 25, 2003 3:56 pm

Post by Pupil »

freak i hope you know that this procedure will give you one byte short for every value that is above 2^32-1. Test yourself by setting hiLong to 1, like this:

Code: Select all

dbl.d\hiLONG = 1
debug StrD(@dbl) ; Should be 4294967296
Top
Tietze
New User
New User
Posts: 2
Joined: Thu Sep 04, 2003 2:50 pm

Post by Tietze »

Hello,

thanks For your help. I coded now this:

Code: Select all

Structure d 
  lowLONG.l 
  hiLONG.l 
EndStructure 

value.d

Structure FourBytes 
  b1.b 
  b2.b 
  b3.b 
  b4.b 
EndStructure 

Procedure.l InversLong(*Long.FourBytes) 
  Protected *InvertedLong.Long 
  *InvertedLong = *Long 
  *InvertedLong\l = *Long\b1 << 24 + *Long\b2 << 16 + *Long\b3 << 8 + *Long\b4

EndProcedure 

Procedure.s StrD(*value.d) 
  Protected buffer1.s, buffer2.s, buffer3.s, pos1.l, pos2.l, pos3.l, calc1.l, calc2.l 
  buffer3 = StrU(*value\lowLONG,#LONG) 
  For pos1 = Len(StrU(*value\hiLONG,#LONG)) To 1 Step -1 
    For pos2 = Len(StrU(-1,#LONG)) To 1 Step -1 
      calc1 = Val(Mid(StrU(*value\hiLONG,#LONG),pos1,1)) * Val(Mid(StrU(-1,#LONG),pos2,1)) 
      calc2 = (Len(StrU(*value\hiLONG,#LONG))-pos1)+(Len(StrU(-1,#LONG))-pos2) 
      buffer1 = Str(calc1) + Left("00000000000000000000",calc2) 
      buffer2 = buffer3 
      buffer3 = "" 
      calc1 = 0 
      If Len(buffer1) > Len(buffer2) 
        buffer2 = Right("00000000000000000000"+buffer2,Len(buffer1)) 
      Else 
        buffer1 = Right("00000000000000000000"+buffer1,Len(buffer2)) 
      EndIf 
      For pos3 = Len(buffer1) To 1 Step -1 
        calc1 + Val(Mid(buffer1,pos3,1)) + Val(Mid(buffer2,pos3,1)) 
        buffer3 = Right(Str(calc1),1)+buffer3 
        calc1/10 
      Next pos3 
      If calc1 > 0: buffer3 = Str(calc1)+buffer3: EndIf 
    Next pos2 
  Next pos1 
  While Left(buffer3,1)="0" 
    buffer3 = Right(buffer3, Len(buffer3)-1) 
  Wend 
  ProcedureReturn buffer3 
EndProcedure 

  If OpenFile(0,"marina_gk4_ok.shp") 

    counter=0
    
    While(Lof()>Loc())
  
    If counter=0
      counter+1
      Long=ReadLong()
      InversLong(@Long)
      Debug "Filecode: " + Str(Long)    
    ElseIf counter>0 And counter<6
      counter+1
      Long=ReadLong()
      InversLong(@Long)
      Debug "Unused: " + Str(Long)    
    ElseIf counter=6
      counter+1
      Long=ReadLong()
      InversLong(@Long)
      Debug "Filesize: " + Str(Long)    
    ElseIf counter=7
      counter+1
      Long=ReadLong()
      Debug "Version:" + Str(Long)    
    ElseIf counter=8
      counter+1
      Long=ReadLong()
      Debug "Shapetyp: " + Str(Long)    
    ElseIf counter=9
      counter+1
      ReadData(@value, 8)
      Debug "X-Min: " +  StrD(@value)     
    ElseIf counter=10
      counter+1
      ReadData(@value, 8)
      Debug "Y-Min: " +  StrD(@value)     
    ElseIf counter=11
      counter+1
      ReadData(@value, 8)
      Debug "X-Max: " +  StrD(@value)     
    ElseIf counter=12
      counter+1
      ReadData(@value, 8)
      Debug "Y-Max: " +  StrD(@value)     
    ElseIf counter=13
      counter+1
      ReadData(@value, 8)
      Debug "Z-Min: " +  StrD(@value)     
    ElseIf counter=14
      counter+1
      ReadData(@value, 8)
      Debug "Z-Max: " +  StrD(@value)     
    ElseIf counter=15
      counter+1
      ReadData(@value, 8)
      Debug "M-Min: " +  StrD(@value)     
    ElseIf counter=16
      counter+1
      ReadData(@value, 8)
      Debug "M-Max: " +  StrD(@value)     
    ElseIf counter>16 And counter<19
      counter+1
      Long=ReadLong()
      Debug "???: " + Str(Long)    


   ;read first information
   ElseIf counter=19
      counter+1
      Long=ReadLong()
      Debug "First:" + Str(Long)    
   ElseIf counter=20
      counter+1
      ReadData(@value, 8)
      Debug "First X:" +  StrD(@value)   
   ElseIf counter=21
      counter+1
      ReadData(@value, 8)
      Debug "First Y:" +  StrD(@value)   
   ElseIf counter=22
      counter+1
      ReadData(@value, 8)
      Debug "First ??:" +  StrD(@value)   
   
   ;read second Information  
   ElseIf counter=23
      counter+1
      Long=ReadLong()
      Debug "Second: " + Str(Long)    
   ElseIf counter=24
      counter+1
      ReadData(@value, 8)
      Debug "Second X: " +  StrD(@value)   
   ElseIf counter=25
      counter+1
      ReadData(@value, 8)
      Debug "Second Y: " +  StrD(@value)   
   ElseIf counter=26
      counter+1
      ReadData(@value, 8)
      Debug "Second ??:" +  StrD(@value)   


    ;read the rest
    Else 
    ReadData(@value, 8)
    EndIf
    

    Wend
    
    CloseFile(0)
        
  EndIf
Now I could Read the header of the file. But X/Y min, X/Y max and X/Y Data in the first and second data record is not ok. These information should have a max lenght of 7 numbers.

You can find the shapefile here:

http://www.vivawasser.de/marina_gk4_ok.shp (58kb)

I hope you understand my problem and you could help me.

Greetings from Kiel

Tietze
Top
Post Reply

Return to “Coding Questions”