读写ArcView Shape文件[转帖]

从代码中抠出来的，大家要自己去提炼，不过，对于懂行的朋友，十分钟就
   可以搞定！里面有很多值得优化的地方，大家可以自己去提高}
  
   //用来直接写DBF文件
     TDbfHeader = record  { Dbase III + header definition        }
        VersionNumber    :byte;  { version number (03h or 83h ) }
        LastUpdateYear   :byte;  { last update YY MM DD         }
        LastUpdateMonth  :byte;
        LastUpdateDay    :byte;
        NumberOfRecords  :longint; { number of record in database }
        BytesInHeader    :smallint;{ number of bytes in header }
        BytesInRecords   :smallint;{ number of bytes in records }
        ReservedInHeader :array[1..20] of char;   { reserved bytes in header }
     end;
  
     TDBFField = record
        FieldName   :array[0..10] of char; { Name of this record             }
        FieldType   :char;           { type of record - C,N,D,L,etc.         }
        fld_addr    :longint;        { not used }
        Width       :byte;           { total field width of this record      }
        Decimals    :byte;           { number of digits to right of decimal  }
        MultiUser   :smallint;       { reserved for multi user }
        WorkAreaID  :byte;           { Work area ID }
        MUser       :smallint;       { reserved for multi_user }
        SetFields   :byte;           { SET_FIELDS flag }
        Reserved    :array[1..4] of byte;      { 8 bytes reserved }
     end;                           { record starts                         }
  
  
   TGeoShapeFile = Class(TGeoFile)
   private
   TotRec : integer;
   function GetBigIntFrom4Byte(A1,A2,A3,A4:Byte):integer; {从文件的BigInt中
       读出数值}
   function GetValueFromBigInt(VV:integer):integer;       {把数值组合成BigInt
        写入文件}
   public
   ShapeFile,ShXFile : File;
   ObjType : integer;   {Shape类型，值为0,1,3,5,8}
  
   Buf64:Double;     {64 bits}
   Buf32:LongInt;    {32 bits}
   Buf16:SmallInt;
   Buf8_1,Buf8_2,Buf8_3,Buf8_4:Byte;  {8 bits}
   BigInt : integer;    {32 bits}
   AggOffSet : integer;    {累计偏移}
  
   constructor Create(FileName: string; OpenMode: FileState);override;
   destructor Destroy;override;
       procedure OpenFile; override;
       procedure CloseFile; override;
  
   function EOF: boolean; override;
   procedure GetFileHeader(var nData: integer; var LayerType : integer; var Rect: TGeoRect); override;
   procedure PutFileHeader(nData: integer; LayerType : integer; Rect: TGeoRect); override;
  
   procedure GetObjHeader(var ObjHeader: TGeoObjHeader); override;
   procedure GetObjXYS(ObjHeader : TGeoObjHeader;PtList : TList;ObjPen : TGeoPen;ObjBrush : TGeoBrush;ObjFont : TGeoFont); override;
   procedure PutObjHeader(var ObjHeader: TGeoObjHeader); override;
   procedure PutObjXYS(PtList : TList; nData: integer); override;
   procedure WriteFileLength;
   procedure WriteDBFFile(NN : integer);
  
   procedure PutFinalSomeThing;override;
   end;
  
  
   constructor TGeoShapeFile.Create(FileName: string; OpenMode: FileState);
   begin
      inherited Create(FileName,OpenMode);
      TotRec := 0;
      AggOffSet := 50;         //初始化的偏移值，一个字长，32位
   end;
  
   destructor TGeoShapeFile.Destroy;
   begin
      inherited Destroy;
   end;
  
   function TGeoShapeFile.GetBigIntFrom4Byte(A1,A2,A3,A4:Byte):integer;
   begin
      Result := A1 * 16777216 +A2 * 65536+ A3 * 256+A4;
   end;
  
   procedure TGeoShapeFile.OpenFile;
   begin
      AssignFile(ShapeFile,GeoFileName);
      if State = fsReadOnly then begin
          Reset(ShapeFile,1);
      end
      else
          if (State = fsReadWrite) then begin
              if Not FileExists(GeoFileName) then
              else
                  if (MessageDlg(‘File already exists, Overwrite now?‘,
                          mtConfirmation, [mbYes, mbNo], 0) = 7) then
                  Exit;
              ReWrite(ShapeFile,1);
          end;
  
      AssignFile(ShXFile,Copy(GeoFileName,1,Length(GeoFileName)-1)+‘X‘);
      if State = fsReadOnly then Reset(ShXFile,1)
      else begin
          if (State = fsReadWrite) then begin
              ReWrite(ShXFile,1);
          end;
      end
   end;
  
   procedure TGeoShapeFile.CloseFile;
   begin
      System.CloseFile(ShapeFile);
      System.CloseFile(ShXFile);
   end;
  
   function TGeoShapeFile.GetValueFromBigInt(VV:integer):integer;
   begin
      Buf8_1 := VV shr 24;
      Buf8_2 := (VV shl 8) shr 24;
      Buf8_3 := (VV shl 16) shr 24;
      Buf8_4 := (VV shl 24) shr 24;
      Result := Buf8_4 * 16777216 +Buf8_3 * 65536+ Buf8_2 * 256+Buf8_1;
   end;
  
   procedure TGeoShapeFile.GetFileHeader(var nData: integer;var LayerType : integer; var Rect: TGeoRect);
   var
      I : integer;
   begin
      for I := 1 to 7 do begin
         BlockRead(ShapeFile,Buf8_1,SizeOf(Buf8_1));
         BlockRead(ShapeFile,Buf8_2,SizeOf(Buf8_2));
         BlockRead(ShapeFile,Buf8_3,SizeOf(Buf8_3));
         BlockRead(ShapeFile,Buf8_4,SizeOf(Buf8_4));
  
         BigInt :=  GetBigIntFrom4Byte(Buf8_1,Buf8_2,Buf8_3,Buf8_4);
      end;
      BlockRead(ShapeFile,Buf32,SizeOf(Buf32));
      BlockRead(ShapeFile,Buf32,SizeOf(Buf32));
   {在GeoLayer中采用GeoUtils中的TGeoObjType来保存层的类型，而在ObjHeader中采用
       类似于ArcVeiw的定义来保存}
      case Buf32 of
      1 : LayerType := 1; {点}
      3 : LayerType := 2; {线}
      5 : LayerType := 3; {多边形}
      8 : LayerType := 4; {多点}
      end;
  
      BlockRead(ShapeFile,Buf64,Sizeof(Buf64));
      Rect.Left := Buf64;
      BlockRead(ShapeFile,Buf64,Sizeof(Buf64));
      Rect.Top := Buf64;
      BlockRead(ShapeFile,Buf64,Sizeof(Buf64));
      Rect.Right := Buf64;
      BlockRead(ShapeFile,Buf64,Sizeof(Buf64));
      Rect.Bottom := Buf64;
  
      //以下四个字节没有使用，保留
      for I := 1 to 8 do begin
         BlockRead(ShapeFile,Buf8_1,SizeOf(Buf8_1));
         BlockRead(ShapeFile,Buf8_2,SizeOf(Buf8_2));
         BlockRead(ShapeFile,Buf8_3,SizeOf(Buf8_3));
         BlockRead(ShapeFile,Buf8_4,SizeOf(Buf8_4));
      end;
   end;
  
   procedure TGeoShapeFile.PutFileHeader(nData: integer; LayerType : integer; Rect: TGeoRect);
   var
      I : integer;
   begin
      Buf32 := GetValueFromBigInt(9994);
      BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));
      BlockWrite(ShxFile,Buf32,SizeOf(Buf32));
      for I := 1 to 5 do begin
          Buf32 := GetValueFromBigInt(0);
          BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));
          BlockWrite(ShxFile,Buf32,SizeOf(Buf32));
      end;
  
      Buf32 := GetValueFromBigInt(0);
      BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));  //文件长度信息，现在为空，最后再来写
      BlockWrite(ShxFile,Buf32,SizeOf(Buf32));
  
      Buf32 := 1000;
      BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));  //版本信息，固定为1000
      BlockWrite(ShxFile,Buf32,SizeOf(Buf32));
  
      {将点、线、面信息转换为Shape文件自己的格式}
      case LayerType of
       1 : Buf32 := 1;
       2 : Buf32 := 3;
       3 : Buf32 := 5;
      end;
  
      BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));  //写Shape类型信息
      BlockWrite(ShxFile,Buf32,SizeOf(Buf32));
  
      Buf64 := Rect.Left;
      BlockWrite(ShapeFile,Buf64,SizeOf(Buf64));
      BlockWrite(ShxFile,Buf64,SizeOf(Buf64));
  
      Buf64 := Rect.Top;
      BlockWrite(ShapeFile,Buf64,SizeOf(Buf64));
      BlockWrite(ShxFile,Buf64,SizeOf(Buf64));
  
      Buf64 := Rect.Right;
      BlockWrite(ShapeFile,Buf64,SizeOf(Buf64));
      BlockWrite(ShxFile,Buf64,SizeOf(Buf64));
  
      Buf64 := Rect.Bottom;
      BlockWrite(ShapeFile,Buf64,SizeOf(Buf64));
      BlockWrite(ShxFile,Buf64,SizeOf(Buf64));
      //以下四个字节没有使用，保留
      for I := 1 to 8 do begin
          Buf32 := GetValueFromBigInt(0);
          BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));
          BlockWrite(ShxFile,Buf32,SizeOf(Buf32));
      end;
   end;
  
   procedure TGeoShapeFile.GetObjHeader(var ObjHeader: TGeoObjHeader);
   var
       I : integer;
       PII : PInt;
   NumParts : integer;
   begin
      BlockRead(ShapeFile,Buf8_1,SizeOf(Buf8_1));
      BlockRead(ShapeFile,Buf8_2,SizeOf(Buf8_2));
      BlockRead(ShapeFile,Buf8_3,SizeOf(Buf8_3));
      BlockRead(ShapeFile,Buf8_4,SizeOf(Buf8_4));
      BigInt :=  GetBigIntFrom4Byte(Buf8_1,Buf8_2,Buf8_3,Buf8_4);
      StrPCopy(ObjHeader.ID ,IntToStr(BigInt));   //get ID from record NO
  
      BlockRead(ShapeFile,Buf8_1,SizeOf(Buf8_1));
      BlockRead(ShapeFile,Buf8_2,SizeOf(Buf8_2));
      BlockRead(ShapeFile,Buf8_3,SizeOf(Buf8_3));
      BlockRead(ShapeFile,Buf8_4,SizeOf(Buf8_4));
      BigInt := GetBigIntFrom4Byte(Buf8_1,Buf8_2,Buf8_3,Buf8_4);
  
      BlockRead(ShapeFile,Buf32,SizeOf(Buf32)); //get shape type
   case Buf32 of
       1 : ObjHeader.ObjType := 1;
       3 : ObjHeader.ObjType := 2;
       5 : ObjHeader.ObjType := 3;
       8 : ObjHeader.ObjType := 4;
       end;
  
      if ObjHeader.ObjType = 1 then begin
            ObjHeader.PointCount := 1;
   GetMem(PII,SizeOf(integer));
            PII^ := 0;
            ObjHeader.Parts.Add(PII);
      end
      else if (ObjHeader.ObjType = 2) or (ObjHeader.ObjType = 3) then begin
          ///////////读BOX//////////////
          BlockRead(ShapeFile,Buf64,Sizeof(Buf64));
          ObjHeader.ObjRect.Left := Buf64;
          BlockRead(ShapeFile,Buf64,Sizeof(Buf64));
          ObjHeader.ObjRect.Top := Buf64;
          BlockRead(ShapeFile,Buf64,Sizeof(Buf64));
          ObjHeader.ObjRect.Right := Buf64;
          BlockRead(ShapeFile,Buf64,Sizeof(Buf64));
          ObjHeader.ObjRect.Bottom := Buf64;
  
          ///////////读NumParts////////
          BlockRead(ShapeFile,Buf32,SizeOf(Buf32));
   NumParts := Buf32;
          //read points‘ count
          BlockRead(ShapeFile,Buf32,SizeOf(Buf32));
          ObjHeader.PointCount := Buf32;
          for I := 1 to NumParts do begin
             GetMem(PII,SizeOf(integer));
              BlockRead(ShapeFile,PII^,SizeOf(Buf32));
              ObjHeader.Parts.Add(PII);
          end;
  
      end
      else if ObjType = 4 then begin
          BlockRead(ShapeFile,Buf64,SizeOf(Buf64));
          ObjHeader.ObjRect.Left := Buf64;
          BlockRead(ShapeFile,Buf64,SizeOf(Buf64));
          ObjHeader.ObjRect.Top := Buf64;
          BlockRead(ShapeFile,Buf64,SizeOf(Buf64));
          ObjHeader.ObjRect.Right := Buf64;
          BlockRead(ShapeFile,Buf64,SizeOf(Buf64));
          ObjHeader.ObjRect.Bottom := Buf64;
  
          BlockRead(ShapeFile,Buf32,SizeOf(Buf32));
          ObjHeader.PointCount := Buf32;
  
          //以后再改
   (*       GetMem(ObjHeader.Parts,ObjHeader.NumParts*SizeOf(integer));
          for I := 1 to ObjHeader.NumParts do begin
              BlockRead(ShapeFile,Buf32,SizeOf(Buf32));
              ObjHeader.Parts^ := Buf32;
          end;
   *)
      end;
   end;
  
   procedure TGeoShapeFile.GetObjXYS(ObjHeader : TGeoObjHeader;PtList : TList;ObjPen : TGeoPen;ObjBrush : TGeoBrush;ObjFont : TGeoFont);
   var
      I : integer;
   GeoPt : PGeoPoint;
   begin
   for I := 0 to ObjHeader.PointCount - 1 do begin
        GetMem(GeoPt,SizeOf(TGeoPoint));
           BlockRead(ShapeFile,Buf64,SizeOf(Buf64));
           GeoPt^.X := Buf64;
           BlockRead(ShapeFile,Buf64,SizeOf(Buf64));
           GeoPt^.Y := Buf64;
           PtList.Add(GeoPt);
       end;
   end;
  
   procedure TGeoShapeFile.PutObjHeader(var ObjHeader: TGeoObjHeader);
   var
      I : integer;
   begin
      //写记录号，不用BNA和XYS中的ID信息，重新生成
      Inc(TotRec);
  
      Buf32 := GetValueFromBigInt(TotRec);
      BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));
  
      //写记录长度
      Buf32 := GetValueFromBigInt(AggOffSet);
      BlockWrite(ShxFile,Buf32,SizeOf(Buf32));        //写记录的偏移
      Buf32 := GetValueFromBigInt(22 + 2*ObjHeader.Parts.Count+8*ObjHeader.PointCount);
  
      BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));      //写shp文件的记录长度
      BlockWrite(ShxFile,Buf32,SizeOf(Buf32));        //写shx文件的记录长度
  
      AggOffSet := AggOffSet + 4 + 22 + 2*ObjHeader.Parts.Count+8*ObjHeader.PointCount;   //偏移量累加
      //写SHP类型
       case ObjHeader.ObjType of
       1 : I := 1;
       2 : I := 3;
       3 : I := 5;
       4 : I := 8;
       end;
  
      BlockWrite(ShapeFile,I,SizeOf(Integer));
  
      if ObjHeader.ObjType = 1 then begin
      end
      else if (ObjHeader.ObjType = 2) or (ObjHeader.ObjType = 3) then begin
          ////////////////写BOX////////////////////
          Buf64 := ObjHeader.ObjRect.Left;
          BlockWrite(ShapeFile,Buf64,Sizeof(Buf64));
          Buf64 := ObjHeader.ObjRect.Top;
          BlockWrite(ShapeFile,Buf64,Sizeof(Buf64));
          Buf64 := ObjHeader.ObjRect.Right;
          BlockWrite(ShapeFile,Buf64,Sizeof(Buf64));
          Buf64 := ObjHeader.ObjRect.Bottom;
          BlockWrite(ShapeFile,Buf64,Sizeof(Buf64));
          ///////////写NumParts////////
          BlockWrite(ShapeFile,ObjHeader.Parts.Count,SizeOf(Buf32));
          ///////////写NumPoints///////
          Buf32 := ObjHeader.PointCount;
          BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));
          for I := 1 to ObjHeader.Parts.Count do begin
              Buf32 := PInt(ObjHeader.Parts.Items[I-1])^;
              BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));
          end;
      end
      else if ObjHeader.ObjType = 4 then begin
          ////////////////写BOX////////////////////
          Buf64 := ObjHeader.ObjRect.Left;
          BlockWrite(ShapeFile,Buf64,Sizeof(Buf64));
          Buf64 := ObjHeader.ObjRect.Top;
          BlockWrite(ShapeFile,Buf64,Sizeof(Buf64));
          Buf64 := ObjHeader.ObjRect.Right;
          BlockWrite(ShapeFile,Buf64,Sizeof(Buf64));
          Buf64 := ObjHeader.ObjRect.Bottom;
          BlockWrite(ShapeFile,Buf64,Sizeof(Buf64));
          ///////////写NumPoints///////
          Buf32 := ObjHeader.PointCount;
          BlockWrite(ShapeFile, Buf32, SizeOf(Buf32));
      end;
   end;
  
   procedure TGeoShapeFile.PutObjXYS(PtList : TList; nData: integer);
   var
      I : integer;
      GeoPt : PGeoPoint;
   begin
       for I := 0 to nData-1 do begin
       GeoPt := PGeoPoint(PtList.Items);
           Buf64 := GeoPt^.X;
           BlockWrite(ShapeFile,Buf64,SizeOf(Buf64));
           Buf64 := GeoPt^.Y;
           BlockWrite(ShapeFile,Buf64,SizeOf(Buf64));
       end;
   end;
  
   function TGeoShapeFile.EOF: boolean;
   begin
      Result := System.Eof(ShapeFile);
   end;
  
   procedure TGeoShapeFile.WriteFileLength;
   begin
      ReSet(ShapeFile,1);
      Seek(ShapeFile,24);
  
      Buf32 := GetValueFromBigInt(Trunc(FileSize(ShapeFile)/2));
      BlockWrite(ShapeFile,Buf32,SizeOf(Buf32));
  
      ReSet(ShxFile,1);
      Seek(ShxFile,24);
  
      Buf32 := GetValueFromBigInt(Trunc(FileSize(ShxFile)/2));
      BlockWrite(ShxFile,Buf32,SizeOf(Buf32));
   end;
  
   procedure TGeoShapeFile.PutFinalSomeThing;
   begin
      WriteFileLength;
   //   WriteDBFFile(TotRec);
   end;
  
  

procedure TGeoShapeFile.WriteDBFFile(NN : integer);//参数为记录个数
   var
      FF : TFileStream;
      DBFHeader : TDBFHeader;
      DBFField : TDBFField;
      Year,Month,Day : word;
      Tmp,I : integer;
   begin
      {只能写空的DBF 文件，只用于XYS,BNA与SHP文件之间的转换,对于BNA的ID，生成一个新的ID_字段保存}
      FF := TFileStream.Create(Copy(GeoFileName,1,Length(GeoFileName)-3)+‘DBF‘,fmCreate);
      FillChar(DBFHeader,SizeOf(TDbfHeader),0);
  
      with DBFHeader do begin
          VersionNumber := 3;
          DecodeDate(Now,Year,Month,Day);
          LastUpdateYear := Year - 1900;              //会有问题
          LastUpdateMonth := Month;
          LastUpdateDay := Day;
          NumberOfRecords := NN;
          BytesInHeader := 65;
          BytesInRecords := 9;
      end;
      FF.WriteBuffer(DBFHeader,SizeOf(TDBFHeader));
  
      FillChar(DBFField,SizeOf(TDBFField),#0);
      with DBFField do begin
          FieldName := ‘ID‘;
          FieldType := ‘N‘;
          Width := 8;
          Decimals := 0;
      end;
      FF.WriteBuffer(DBFField,SizeOf(TDBFField));
  
      Tmp := 13;
      FF.WriteBuffer(Tmp,SizeOf(Byte));
  
      for I := 1 to NN do begin
          Tmp := 32;
          FF.WriteBuffer(Tmp,SizeOf(Byte));
          Tmp := 1;
          FF.WriteBuffer(Tmp,8);
      end;
  
      Tmp := 26;
      FF.WriteBuffer(Tmp,SizeOf(Byte));
      FF.Free;
   end;

good

谢谢。

下载后漫漫看看那