pdfファイルのプロパティを取得するには (ID：5562)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

せっかくですから文字コードの変換関数でも置いておきます;;;

(*
   PDFDocEncoding
   PDFDocDecoding
   AsciiHexEncoding
   AsciiHexDeccoding
   Sjis2Unicode2Hex
   UnicodeHex2Sjis
*)

{ 整数をByteの範囲まで丸める }
function RoundoByte(d : Integer):Byte;
begin
    if d >255 then
      Result :=255
    else
      Result :=d;
end;

{ 文字が16進表記か判別する }
function IsHex(S :char):Boolean;
begin
   if Byte(s) in [$41..$46,$61..$66,$30..$39] then
    Result :=True
   else
    Result :=False;
end;

{ 欧米文字コードをAsciiコードのみに変換する }
function EuroCodeToAsciiCode(S :String):String;
var
 P :Pchar;
begin
   Result :='';
   P :=Pchar(s);
   while not (P^=#0) do
   begin
    if Byte(P^) in [$20..$7E,$0A,$0D] then
       Result := Result+P^
    else
       Result := Result+'?';
    Inc(P);
   end;
end;

{ 文字がSjisコードか判別する }
function IsSjis(S : String) :Boolean;
var
 Size :Byte;
begin
 Result :=False;
 Size   :=RoundoByte(Length(S));
 case  Size of
  0 :  Exit;
  1 :  begin
          if (Byte(S[1]) in [$0A, $0D] ) or
             (Byte(S[1]) in [$20..$7E] ) or                        // Ascii
             (Byte(S[1]) in [$A1..$DF] ) then  Result:=True;       // 半角カタカナ
       end;
  else begin
          if (Byte(S[1]) in [$80..$9F,$E0..$FC]) and                  // 漢字コードの第一バイト
             (Byte(S[2]) in [$40..$7E,$80..$FC]) then  Result:=True;  // 漢字コードの第二バイト
       end;
 end;
end;

{ 10進文字よりByteへ変換}
function DecimalCharToByte(c :char) :Byte;
begin
 if c in ['0'..'9'] then
   Result :=Byte(c)-$30
 else
   Result :=0;
end;

{ 8進数文字列からByteへ変換 }
function OctalStrToByte(Value:string):Integer;
var
 Size     : Byte;
 a1,a2,a3 : char;
 b1,b2,b3 : Byte;
begin
   Result :=0;
   Size   := RoundoByte(Length(Value));
   case Size of
    0      : Exit;
    1      : begin
                 a1 :='0';
                 a2 :='0';
                 a3 :=Value[1];
             end;
    2      : begin
                 a1 :='0'  ;
                 a2 :=Value[1];
                 a3 :=Value[2];
             end;
    else     begin
                 a1 :=Value[1];
                 a2 :=Value[2];
                 a3 :=Value[3];
             end;
   end;

b1:=DecimalCharToByte(a1);
   b2:=DecimalCharToByte(a2);
   b3:=DecimalCharToByte(a3);

Result :=b1 shl 6 + b2 shl 3 +b3;
end;

{ 8進数文字列からAscii Hexへ変換 }
function OctalStrToByteHexStr(Value:string):String;
begin
  Result :=InttoHex(OctalStrToByte(Value),2);
end;

{ Byteから8進数文字列へ変換 }
function ByteToOctalStr(Value :Byte):string;
var
  a1,a2,a3 :Byte;
begin
    // 下位1-3bit
    a1 := (Value and $07) ;

// 下位4-6bit
    a2 := (Value and $38) shr 3;

// 下位7-8bit
    a3 := (Value and $C0) shr 6 ;

Result:= Format('%d%d%d',[a3,a2,a1]);
end;

{ エンディアン変換 }
procedure Endian(Var Soce :PwordArray;Size :Integer);
var
  i :integer;
  Buffer :Word;
begin
   for i:= 0 to Size  -1 do
   begin
       Buffer :=(Soce[i] and $00FF) shl 8 ;
       Soce[i] :=Buffer+(Soce[i] and $FF00) shr 8  ;
   end;
end;

{ Byte->Hex->Wordに変換 }
function ByteToHexWord(B: Byte) :Word;
Var
 Hi,Lo :Byte;
begin
  Hi:=(B And $F0) shr 4;
  Lo:=B And $0F;

case Hi of
   0..9   : Hi:=  Hi+48;
   10..15 : Hi:=  Hi+55;
  end;

case Lo of
   0..9   : Lo:=  Lo+48;
   10..15 : Lo:=  Lo+55;
  end;

Result:= (Lo shl 8) or Hi;
end;

// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
//   PDFDocEncoding
// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
function PDFDocEncoding(s :String):String;
var
  HiByte,LoByte : Byte;
  StrSize,i : integer;
  StrMem    : PWideChar;
  SrctRow   : PWordArray;
begin
    Result :=''; 
    StrSize  := Length(s) * 2;
    StrMem   := AllocMem(StrSize+2);
    try

// SjisからUnicodeに変換 -----------------------------------------------

StringToWideChar(s, StrMem, StrSize);

// エンディアン変換
         StrSize := Length(StrMem);
         Endian(PWordArray(StrMem),StrSize);

// UnicodeからPDFDocEncodingに変換 -------------------------------------

SrctRow:= PWordArray(StrMem);
         for i:= 0 to StrSize-1 do
         begin                    
              HiByte:=Hi(SrctRow[i]);
              LoByte:=Lo(SrctRow[i]);

// 印字可能な範囲ならば
              if LoByte in [$20..$7F] then
              begin
                 // 「\,(,)」ならば「\」を追加
                 if LoByte in [$5C,$28,$29]  then
                 begin
                    // エスケープ文字
                    case LoByte of
                       // \
                       $5C:Result:=Result+'\\';
                       // (
                       $28:Result:=Result+'$';
                       // )
                       $29:Result:=Result+'$';
                    end
                 end
                 else
                    // ASCII表記
                    Result :=Result+ char(LoByte);
              end
              else
              begin
                 // 8進表記
                 Result :=Result+'\'+ByteToOctalStr(LoByte);
              end;

// 印字可能な範囲ならば
              if HiByte in [$20..$7F] then
              begin
                 // 「\,(,)」ならば「\」を追加
                 if HiByte in [$5C,$28,$29]  then
                 begin
                    // エスケープ文字
                    case HiByte of
                       // \
                       $5C:Result:=Result+'\\';
                       // (
                       $28:Result:=Result+'$';
                       // )
                       $29:Result:=Result+'$';
                    end
                 end
                 else
                 // ASCII表記
                 Result :=Result+ char(HiByte);
              end
              else
              begin
                 // 8進表記
                 Result :=Result+'\'+ByteToOctalStr(HiByte);
              end;
         end;

finally
      FreeMem(StrMem);
    end;

if Result<>'' then
     Result:='\376\377'+Result;
end;

// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
//   PDFDocDecoding
// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
function PDFDocDecoding(s :String):String;
var
  P : Pchar;
  c : string;
  a1,a2,a3 :char;
const
  // Unicode Byte Order Maker
  BOM        : string = '\376\377' ;
  BOM_LENGTH : Byte   = 8;
begin

Result:='';   c:='';
      P :=PChar(s);
      if s='' then Exit;
      
      // 先頭にBOMがあればBOMをスキップする
      if Length(s) >= BOM_LENGTH then
         if Copy(S,1,BOM_LENGTH) = BOM then
            Inc(P,BOM_LENGTH);

// PDFDocEncodingからUnicodeへ変換 ---------------------------------------

While not (P^ = #0) do
      begin
         case P^ of
           '\' : begin
                   // 8進表記かエスケープかを判別するため次の文字を取得
                   Inc(P); if P^ = #0 then  break;

case P^ of
                      (* この[\]はエスケープ文字である -----------------------*)
                      '\' : c:=c+ InttoHex($5C,2) ; // Backslash
                      '(' : c:=c+ InttoHex($28,2) ; // Left parenthesis
                      ')' : c:=c+ InttoHex($29,2) ; // Right parenthesis
                      'n' : c:=c+ InttoHex($0A,2) ; // linefeed
                      'r' : c:=c+ InttoHex($0D,2) ; // carriage return
                      't' : c:=c+ InttoHex($09,2) ; // horizontal tab
                      'b' : c:=c+ InttoHex($08,2) ; // backspace
                      'f' : c:=c+ InttoHex($0C,2) ; // formfeed
                      (* この[\]は改行コードである ---------------------------*)
                      #10,#13      : begin
                                        // 改行コードが「CR+LF」かチェック
                                        if P^=#13 then
                                        begin
                                          Inc(P);
                                          if P^ <> #10 then Dec(P);
                                        end;    
                                     end ;
                      (* この[\]は8進表記である ------------------------------*)
                      '0'..'9'     : begin

// 8進表記(\ddd)の \dxx のとき
                                       a1:=P^; Inc(P);
                                       if P^ = #0  then
                                       begin
                                         c:= c+OctalStrToByteHexStr(a1);
                                         break;
                                       end;
                                       if  not (P^ in ['0'..'9']) then
                                       begin
                                         c:= c+OctalStrToByteHexStr(a1);
                                         Continue;
                                       end;

// 8進表記(\ddd)の \ddx のとき
                                       a2:=P^; Inc(P);
                                       if P^ = #0  then
                                       begin
                                         c:= c+OctalStrToByteHexStr(a1+a2);
                                         break;
                                       end;
                                       if  not (P^ in ['0'..'9']) then
                                       begin
                                         c:= c+OctalStrToByteHexStr(a1+a2);
                                         Continue;
                                       end;

// 8進表記(\ddd)の \ddd のとき
                                       a3:=P^;
                                       c:= c+OctalStrToByteHexStr(a1+a2+a3);
                                    end;

//  エスケープシーケンスが不正な場合は無視する
                   //   else
                   //    Break;
                   end;
                 end;
            else
            begin
              // Ascii文字->Ascii HexDump
              c:=c+ InttoHex(Byte(P^),2) ;
            end;
          end;
         Inc(P);
      end;

// Unicode HexからSjisへ変換 ---------------------------------------------

Result :=UnicodeHex2Sjis(c);   
end;

// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
//  AsciiHexEncoding
// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
function AsciiHexEncoding(Buffer :PByteArray;Size: Dword):String;
Var
 i :integer;
 DestBuf : Pointer;
 Dest    : PWordArray;
begin
   Result:='';
   GetMem(DestBuf,Size*2);
   Dest:=DestBuf;
   try
     for i:= 0 to size-1 do
        Dest[i] := ByteToHexWord(Buffer[i]);

Result :=copy(Pchar(Dest),1,Size*2);

finally
     if DestBuf<>nil then Freemem(DestBuf);
   end;
end;

// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
//  AsciiHexDeccoding
// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
function AsciiHexDeccoding(const S : String; var Buffer :Pointer):Integer;
var
 P   : Pchar;
 str : Char;
  i  : integer;
 Line : PByteArray;
begin
   Result :=0; Buffer :=nil;
   if s='' then Exit;

GetMem(Buffer,Length(s));
   Line:=Buffer; i:=0;

P :=Pchar(s);
   while not (P^=#0) do
   begin
     // 16進表記ならば
     if IsHex(P^) then
     begin
       Str:=P^;  Inc(P);
       if P^=#0 then break;

if IsHex(P^) then
       begin
         // 反則技 (^^;
         Line[i]:= StrtoIntDef('$'+Str+P^,0);
         Inc(i);
       end;
     end;
     Inc(P);
   end;

Result:=i;
end;

// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
//   Sjis2Unicode2Hex
// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
function Sjis2Unicode2Hex(S: string):String;
var
  StrMem  : PWideChar;
  StrSize : integer;
begin
    StrSize  := Length(S) * 2;
    StrMem   := AllocMem(StrSize+2);
    try
        // SjisからUnicode文字列に変換
        StringToWideChar(S, StrMem, StrSize);

// エンディアン変換
        StrSize := Length(StrMem);
        Endian(PWordArray(StrMem),StrSize);

// Unicodeの識別子
        Result :='FEFF';

// 16進表記に変換
        Result :=AsciiHexEncoding(PByteArray(StrMem),StrSize*2);

finally
      FreeMem(StrMem);
    end;
end;

// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
//   UnicodeHex2Sjis
// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
function UnicodeHex2Sjis(S: string):String;
var
  P  : Pchar;
  d,Sjis  : string;
  PW : array [0..1] of WideChar;
  i,Size : integer;
begin
     Result :='';
     ZeroMemory(@PW,Sizeof(WideChar)*2);
     if S ='' then Exit;

// 文字列が途切れている場合は1つだけ文字を削除して対処する
     Size:= Length(S);
     if (Size mod  2)<>0 then
     begin
        if Size-1  > 2 then
          Size:= Size -1
        else
          Exit;
     end;

P :=Pchar(S);
     for i:= 0 to (Size div 4)-1 do
     begin
       // Unicode Hexからマルチバイト文字へ変換
       d:=P^;    Inc(P);
       d:=d+P^;  Inc(P);
       d:=d+P^;  Inc(P);
       d:=d+P^;  Inc(P);
       PW[0] :=WideChar(strtoInt('$'+d));

// UnicodeからSjisへ変換(中国語や韓国語などは「?」にする)
       Sjis  :=WideCharToString(PW);
       if IsSjis(Sjis) then
         Result := Result+ Sjis
       else
         Result := Result+ '?';
     end;
end;

←解決時は質問者本人がここをチェックしてください。

戻る