读写ArcView Shape文件（3.0）(0分)

{哈，是从我的代码中抠出来的，大家要自己去提炼，不过，对于懂行的朋友，十分钟就
可以搞定！
另：代码写得久了，里面有很多值得优化的地方，大家可以自己去提高}

//用来直接写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}

Buf64ouble;
{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 7do
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 8do
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 5do
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 8do
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 NumPartsdo
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.NumPartsdo
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 - 1do
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.Countdo
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-1do
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 DBFHeaderdo
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 DBFFielddo
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 NNdo
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;

好东西，踢一脚！^_^

你让我找了半天，好：）

老大gis，dbfile都很牛啊。。。[8D][8D][8D][8D]

小哥，帮帮我吧，我想屏蔽一个activex控件的右键，怎样才可以？？
这个activex控件是voloview
谢谢了！！！！

请问程序中 BigInt : integer;
AggOffSet : integer;
{累计偏移}
这两个变量起什么作用？
谢谢

BigInt是Shape文件定义的一种不同于Windows平台上整形的一种整形类型，其高二字节和低
二字节取反。
累计偏移是用于计算Shx文件中的偏移记录数值。

吕雪松大虾：
TGeoObjHeader是怎么定义的，在下实在愚笨，怎么也想不出来。现在正在写一个小程序，
把一堆点连成线，存成shp文件，不想用ArcGIS+VBA，想直接写，希望大虾指点一二。
谢谢。
whaw2000@yahoo.com
hw8c2@mizzou.edu