restemplate/indy/Protocols/IdWebDAV.pas

329 lines
12 KiB
Plaintext

{
$Project$
$Workfile$
$Revision$
$DateUTC$
$Id$
This file is part of the Indy (Internet Direct) project, and is offered
under the dual-licensing agreement described on the Indy website.
(http://www.indyproject.org/)
Copyright:
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
$Log$
}
unit IdWebDAV;
//implements http://www.faqs.org/rfcs/rfc2518.html
{
general cleanup possibilities:
todo change embedded strings to consts
todo change depth param from infinity to -1? also string>integer?
}
interface
{$i IdCompilerDefines.inc}
uses
Classes,
IdHTTP;
const
Id_HTTPMethodPropFind = 'PROPFIND'; {do not localize}
Id_HTTPMethodPropPatch = 'PROPPATCH'; {do not localize}
Id_HTTPMethodOrderPatch = 'ORDERPATCH'; {do not localize}
Id_HTTPMethodSearch = 'SEARCH'; {do not localize}
Id_HTTPMethodMKCol = 'MKCOL'; {do not localize}
Id_HTTPMethodMove = 'MOVE'; {do not localize}
Id_HTTPMethodCopy = 'COPY'; {do not localize}
Id_HTTPMethodCheckIn = 'CHECKIN'; {do not localize}
Id_HTTPMethodCheckOut = 'CHECKOUT'; {do not localize}
Id_HTTPMethodUnCheckOut = 'UNCHECKOUT'; {do not localize}
Id_HTTPMethodLock = 'LOCK'; {do not localize}
Id_HTTPMethodUnLock = 'UNLOCK'; {do not localize}
Id_HTTPMethodReport = 'REPORT'; {do not localize}
Id_HTTPMethodVersion = 'VERSION-CONTROL'; {do not localize}
Id_HTTPMethodLabel = 'LABEL'; {do not localize}
Id_HTTPMethodMakeCol = 'MKCOL'; {Do not localize}
const
//casing is according to rfc
cTimeoutInfinite = 'Infinite'; {do not localize}
cDepthInfinity = 'infinity'; {do not localize}
type
TIdWebDAV = class(TIdHTTP)
public
procedure DAVCheckIn(const AURL, AComment: string);
procedure DAVCheckOut(const AURL: string; const AXMLQuery: TStream; const AComment: string);
procedure DAVCopy(const AURL, DURL: string; const AResponseContent: TStream; const AOverWrite: boolean = True; const ADepth: string = cDepthInfinity);
procedure DAVDelete(const AURL: string; const ALockToken: string);
procedure DAVLabel(const AURL: string; const AXMLQuery: TStream);
procedure DAVLock(const AURL: string; const AXMLQuery, AResponseContent: TStream; const ALockToken, ATags: string; const ATimeOut: string = cTimeoutInfinite; const AMustExist: Boolean = False; const ADepth: string = '0'); {do not localize}
procedure DAVMove(const AURL, DURL: string; const AResponseContent: TStream; const AOverWrite: Boolean = True; const ADepth: string = cDepthInfinity);
procedure DAVOrderPatch(const AURL: string; const AXMLQuery: TStream);
procedure DAVPropFind(const AURL: string; const AXMLQuery, AResponseContent: TStream; const ADepth: string = '0'; const ARangeFrom: Integer = -1; const ARangeTo: Integer = -1); {do not localize}
procedure DAVPropPatch(const AURL: string; const AXMLQuery, AResponseContent: TStream; const ADepth: string = '0'); {do not localize}
procedure DAVPut(const AURL: string; const ASource: TStream; const ALockToken: String);
procedure DAVReport(const AURL: string; const AXMLQuery, AResponseContent: TStream);
procedure DAVSearch(const AURL: string; const ARangeFrom, ARangeTo: Integer; const AXMLQuery, AResponseContent: TStream; const ADepth: string = '0'); {do not localize}
procedure DAVUnCheckOut(const AURL: String);
procedure DAVUnLock(const AURL: string; const ALockToken: string);
procedure DAVVersionControl(const AURL: string);
procedure DAVMakeCollection(const AURL: string);
end;
implementation
uses
IdGlobal, SysUtils;
procedure TIdWebDAV.DAVPropPatch(const AURL: string; const AXMLQuery, AResponseContent: TStream;
const ADepth: string);
begin
Request.CustomHeaders.Values['Depth'] := ADepth; {do not localize}
try
DoRequest(Id_HTTPMethodPropPatch, AURL, AXMLQuery, AResponseContent, []);
finally
Request.CustomHeaders.Values['Depth'] := ''; {do not localize}
end;
end;
procedure TIdWebDAV.DAVPropFind(const AURL: string; const AXMLQuery, AResponseContent: TStream;
const ADepth: string; const ARangeFrom: Integer; const ARangeTo: Integer);
begin
if ARangeTo > -1 then begin
Request.CustomHeaders.Values['Range'] := 'Rows=' + IntToStr(ARangeFrom) + '-' + IntToStr(ARangeTo); {do not localize}
end else begin
Request.CustomHeaders.Values['Range'] := ''; {do not localize}
end;
Request.CustomHeaders.Values['Depth'] := ADepth; {do not localize}
try
DoRequest(Id_HTTPMethodPropfind, AURL, AXMLQuery, AResponseContent, []);
finally
Request.CustomHeaders.Values['Depth'] := ''; {do not localize}
if ARangeTo > -1 then begin
Request.CustomHeaders.Values['Range'] := ''; {do not localize}
end;
end;
end;
procedure TIdWebDAV.DAVOrderPatch(const AURL: string; const AXMLQuery: TStream);
begin
DoRequest(Id_HTTPMethodOrderPatch, AURL, AXMLQuery, nil, []);
end;
procedure TIdWebDAV.DAVSearch(const AURL: string; const ARangeFrom, ARangeTo: Integer;
const AXMLQuery, AResponseContent: TStream; const ADepth: string);
begin
if ARangeTo > -1 then begin
Request.CustomHeaders.Values['Range'] := 'Rows=' + IntToStr(ARangeFrom) + '-' + IntToStr(ARangeTo); {do not localize}
end else begin
Request.CustomHeaders.Values['Range'] := ''; {do not localize}
end;
Request.CustomHeaders.Values['Depth'] := ADepth; {do not localize}
try
DoRequest(Id_HTTPMethodSearch, AURL, AXMLQuery, AResponseContent, []);
finally
Request.CustomHeaders.Values['Depth'] := ''; {do not localize}
if ARangeTo > -1 then begin
Request.CustomHeaders.Values['Range'] := ''; {do not localize}
end;
end;
end;
procedure TIdWebDAV.DAVMove(const AURL, DURL: string; const AResponseContent: TStream;
const AOverWrite: Boolean; const ADepth: string);
begin
if not AOverWrite then begin
Request.CustomHeaders.Values['Overwrite'] := 'F'; {do not localize}
end else begin
Request.CustomHeaders.Values['Overwrite'] := ''; {do not localize}
end;
Request.CustomHeaders.Values['Destination'] := DURL; {do not localize}
Request.CustomHeaders.Values['Depth'] := ADepth; {do not localize}
try
DoRequest(Id_HTTPMethodMove, AURL, nil, AResponseContent, []);
finally
Request.CustomHeaders.Values['Destination'] := ''; {do not localize}
if not AOverWrite then begin
Request.CustomHeaders.Values['Overwrite']; {do not localize}
end;
Request.CustomHeaders.Values['Depth'] := ''; {do not localize}
end;
end;
procedure TIdWebDAV.DAVCopy(const AURL, DURL: string; const AResponseContent: TStream;
const AOverWrite: Boolean; const ADepth: string);
begin
Request.CustomHeaders.Values['Destination'] := DURL; {do not localize}
Request.CustomHeaders.Values['Overwrite'] := iif(AOverWrite, 'T', 'F'); {do not localize}
Request.CustomHeaders.Values['Depth'] := ADepth; {do not localize}
try
DoRequest(Id_HTTPMethodCopy, AURL, nil, AResponseContent, []);
finally
Request.CustomHeaders.Values['Destination'] := ''; {do not localize}
Request.CustomHeaders.Values['Overwrite'] := ''; {do not localize}
Request.CustomHeaders.Values['Depth'] := ''; {do not localize}
end;
end;
procedure TIdWebDAV.DAVCheckIn(const AURL, AComment: string);
var
LXML: TMemoryStream;
s: string;
begin
DoRequest(Id_HTTPMethodCheckIn, AURL, nil, nil, []);
if AComment <> '' then
begin
s := '<?xml version="1.0" encoding="utf-8" ?>' + {do not localize}
'<propertyupdate xmlns:D="DAV:"><set><prop>' + {do not localize}
'<comment>' + AComment + '</comment></prop></set></propertyupdate>'; {do not localize}
LXML := TMemoryStream.Create;
try
WriteStringToStream(LXML, s, IndyTextEncoding_UTF8);
LXML.Position := 0;
DoRequest(Id_HTTPMethodPropPatch, AURL, LXML, nil, []);
finally
LXML.Free;
end;
end;
end;
procedure TIdWebDAV.DAVCheckOut(const AURL: String; const AXMLQuery: TStream; const AComment: String);
var
LXML: TMemoryStream;
s: string;
begin
DoRequest(Id_HTTPMethodCheckOut, AURL, AXMLQuery, nil, []);
if AComment <> '' then
begin
s := '<?xml version="1.0" encoding="utf-8" ?>' + {do not localize}
'<propertyupdate xmlns:D="DAV:"><set><prop>' + {do not localize}
'<comment>' + AComment + '</comment></prop></set></propertyupdate>'; {do not localize}
LXML := TMemoryStream.Create;
try
WriteStringToStream(LXML, s, IndyTextEncoding_UTF8);
LXML.Position := 0;
DoRequest(Id_HTTPMethodPropPatch, AURL, LXML, nil, []);
finally
LXML.Free;
end;
end;
end;
procedure TIdWebDAV.DAVUnCheckOut(const AURL: string);
begin
DoRequest(Id_HTTPMethodUnCheckOut, AURL, nil, nil, []);
end;
procedure TIdWebDAV.DAVLock(const AURL: string; const AXMLQuery, AResponseContent: TStream;
const ALockToken, ATags: string; const ATimeOut: string; const AMustExist: Boolean;
const ADepth: string);
begin
//NOTE - do not specify a LockToken and Tags value. If both exist then only
//LockToken will be used. If you wish to use LockToken together with other
//tags then concatenate and send via Tags value.
//Also note that specifying the lock token in a lock request facilitates
//a lock refresh
Request.CustomHeaders.Values['Timeout'] := ATimeOut; {do not localize}
if AMustExist then
begin
Request.CustomHeaders.Values['If-Match'] := '*'; {do not localize}
Request.CustomHeaders.Values['If-None-Match'] := ''; {do not localize}
end else
begin
Request.CustomHeaders.Values['If-Match'] := ''; {do not localize}
Request.CustomHeaders.Values['If-None-Match'] := '*'; {do not localize}
end;
Request.CustomHeaders.Values['Depth'] := ADepth; {do not localize}
if ALockToken <> '' then begin
Request.CustomHeaders.Values['If'] := '(<'+ALockToken+'>)'; {do not localize}
end
else if ATags <> '' then begin
Request.CustomHeaders.Values['If'] := '('+ATags+')'; {do not localize}
end else begin
Request.CustomHeaders.Values['If'] := ''; {do not localize}
end;
try
DoRequest(Id_HTTPMethodLock, AURL, AXMLQuery, AResponseContent, []);
finally
Request.CustomHeaders.Values['Timeout'] := ''; {do not localize}
Request.CustomHeaders.Values['If-Match'] := ''; {do not localize}
Request.CustomHeaders.Values['If-None-Match'] := ''; {do not localize}
Request.CustomHeaders.Values['Depth'] := ''; {do not localize}
Request.CustomHeaders.Values['If'] := ''; {do not localize}
end;
end;
procedure TIdWebDAV.DAVUnLock(const AURL: string; const ALockToken: string);
begin
Request.CustomHeaders.Values['Lock-Token'] := '<'+ALockToken+'>'; {do not localize}
try
DoRequest(Id_HTTPMethodUnLock, AURL, nil, nil, []);
finally
Request.CustomHeaders.Values['Lock-Token'] := ''; {do not localize}
end;
end;
procedure TIdWebDAV.DAVReport(const AURL: string; const AXMLQuery, AResponseContent: TStream);
begin
DoRequest(Id_HTTPMethodReport, AURL, AXMLQuery, AResponseContent, []);
end;
procedure TIdWebDAV.DAVVersionControl(const AURL: string);
begin
DoRequest(Id_HTTPMethodVersion, AURL, nil, nil, []);
end;
procedure TIdWebDAV.DAVLabel(const AURL: string; const AXMLQuery: TStream);
begin
DoRequest(Id_HTTPMethodLabel, AURL, AXMLQuery, nil, []);
end;
procedure TIdWebDAV.DAVPut(const AURL: string; const ASource: TStream; const ALockToken: String);
begin
if ALockToken <> '' then begin
Request.CustomHeaders.Values['If'] := '(<'+ALockToken+'>)'; {do not localize}
end else begin
Request.CustomHeaders.Values['If'] := ''; {do not localize}
end;
try
inherited Put(AURL, ASource, TStream(nil));
finally
if ALockToken <> '' then begin
Request.CustomHeaders.Values['If'] := ''; {do not localize}
end;
end;
end;
procedure TIdWebDAV.DAVDelete(const AURL: string; const ALockToken: string);
begin
if ALockToken <> '' then begin
Request.CustomHeaders.Values['If'] := '(<'+ALockToken+'>)'; {do not localize}
end else begin
Request.CustomHeaders.Values['If'] := ''; {do not localize}
end;
try
inherited Delete(AURL);
finally
if ALockToken <> '' then begin
Request.CustomHeaders.Values['If'] := ''; {do not localize}
end;
end;
end;
procedure TIdWebDAV.DAVMakeCollection(const AURL: string);
begin
DoRequest(Id_HTTPMethodMakeCol, AURL, nil, nil, []);
end;
end.