Base32

Base32 beschreibt ein Verfahren zur Kodierung von Binärdaten in eine Zeichenfolge, die nur aus 32 verschiedenen ASCII-Zeichen (A..Z, 2..7) besteht, plus einem zusätzlichen Zeichen (=) zum Füllzeichen am Datenende.

Da ich bisher keine ordentlich funktionierende Pascal Variante im Netz finden konnte, nun meine Varianten mit unterschiedlichen Übergabemöglichkeiten.

base32.pas Pascal (3,63 kByte) 20.09.2015 22:28
// *****************************************************************************
//  Title.............. :  base32
//
//  Modulname ......... :  base32.pas
//  Type .............. :  Unit
//  Author ............ :  Udo Schmal
//  Development Status  :  20.09.2015
//  Operating System .. :  Win32/Win64
//  IDE ............... :  Delphi & Lazarus
// *****************************************************************************
unit base32;
{$ifdef fpc}
  {$mode objfpc}
{$endif}
{$H+}
interface

uses
  SysUtils, Classes;

function Base32Encode(source: string): string;
function Base32Encode(const buf; len: integer): string;
function Base32Encode(var Stream: TMemoryStream): string;
function Base32Decode(source: ansistring): ansistring;

implementation

const
  base32chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ234567';

function Base32Encode(source: string): string;
var
  i: integer;
  nr: int64;
begin
  result := '';
  while length(source) > 0 do
  begin
    nr := 0;
    for i := 1 to 5 do
    begin
      nr := (nr shl 8);
      if length(source)>=i then
        nr := nr + byte(source[i]);
    end;
    for i := 7 downto 0 do
      if ((length(source)<2) and (i<6)) or
         ((length(source)<3) and (i<4)) or
         ((length(source)<4) and (i<3)) or
         ((length(source)<5) and (i<1)) then
      result := result + '='
    else
      result := result + base32chars[((nr shr (i*5)) and $1F)+1];
    delete(source, 1, 5);
  end;
end;

function Base32Encode(const buf; len: integer): string;
var
  i: integer;
  nr: int64;
  arr: array of byte;
begin
  result := '';
  SetLength(arr, len);
  Move(buf, arr[0], len);
  while length(arr) > 0 do
  begin
    nr := 0;
    for i := 1 to 5 do
    begin
      nr := (nr shl 8);
      if length(arr)>=i then
        nr := nr + byte(arr[i-1]);
    end;
    for i := 7 downto 0 do
      if ((length(arr)<2) and (i<6)) or
         ((length(arr)<3) and (i<4)) or
         ((length(arr)<4) and (i<3)) or
         ((length(arr)<5) and (i<1)) then
      result := result + '='
    else
      result := result + base32chars[((nr shr (i*5)) and $1F)+1];
    if length(arr)>5 then
    begin
      move(arr[5], arr[0], length(arr)-5);
      setlength(arr, length(arr)-5);
    end
    else
      setlength(arr, 0);
  end;
end;

function Base32Encode(var Stream:TMemoryStream): string;
var
  i: integer;
  nr: int64;
  arr: array of byte;
begin
  result := '';
  Stream.Position := 0;
  SetLength(arr, Stream.Size);
  Stream.Read(arr[0], Stream.Size);
  while length(arr) > 0 do
  begin
    nr := 0;
    for i := 1 to 5 do
    begin
      nr := (nr shl 8);
      if length(arr)>=i then
        nr := nr + byte(arr[i-1]);
    end;
    for i := 7 downto 0 do
      if ((length(arr)<2) and (i<6)) or
         ((length(arr)<3) and (i<4)) or
         ((length(arr)<4) and (i<3)) or
         ((length(arr)<5) and (i<1)) then
      result := result + '='
    else
      result := result + base32chars[((nr shr (i*5)) and $1F)+1];
    if length(arr)>5 then
    begin
      move(arr[5], arr[0], length(arr)-5);
      setlength(arr, length(arr)-5);
    end
    else
      setlength(arr, 0);
  end;
end;

function Base32Decode(source: ansistring): ansistring;
var
  i, p: integer;
  nr: Int64;
begin
  result := '';
  while length(source) >= 8 do
  begin
    nr := 0;
    for i := 1 to 8 do
    begin
      nr := (nr shl 5);
      p := pos(source[i], base32chars);
      if p>0 then
        nr := nr + p-1;
    end;
    for i := 4 downto 0 do
      result := result + chr((nr shr (i*8)) and $FF);
    delete(source, 1, 8);
  end;
end;

end.

Autor: , veröffentlicht: , letzte Änderung:

Kontakt

Copyright / License of sources

Copyright (c) 2007-2017, Udo Schmal <udo.schmal@t-online.de>

Permission to use, copy, modify, and/or distribute the software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies.

THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

Service Infos

CMS Info
UDOs Webserver

0.3.1.24

All in one Webserver

Udo Schmal

Sa, 21 Okt 2017 00:30:10
Development Info
Lazarus LCL 1.9.0.0

Free Pascal FPC 3.1.1

OS:Win64, CPU:x86_64
Hardware Info
Precision WorkStation T3500

Intel(R) Xeon(R) CPU W3530 @ 2.80GHz

x86_64, 1 physical CPU(s), 4 Core(s), 8 logical CPU(s), 2800 MHz