Advertisement
jacknpoe

Classe pra acesso direto em arquivo com criptografia básica

Oct 22nd, 2013
162
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 24.55 KB | None | 0 0
  1. {############################################################################
  2. #
  3. #   DOCUMENTAÇÃO DA UNIDADE UARQUIVODIRETO (UArquivoDireto.pas)
  4. #
  5. #   Autor: Ricardo Erick Rebêlo
  6. #   Última Modificação: 13/03/05
  7. #
  8. #############################################################################
  9.  
  10.  
  11. USES
  12. ====
  13.  
  14. Tipos: TEModoArquivo
  15.        TEErroArquivo
  16.  
  17.  
  18. CLASSES
  19. =======
  20.  
  21. TArquivoDireto
  22.  
  23.     Descrição: Arquivo binário de Leitura ou Escrita com métodos
  24.                para salvar e ler vários tipos de dados,
  25.                com criptografia simples e controle de erros
  26.  
  27.     Autor: Ricardo Erick Rebêlo
  28.  
  29.     Portabilidade: versões diferentes do DELPHI geram códigos incompatíveis entre si,
  30.                    pois os tipos integer e real podem sofrer alterações de tamanho
  31.  
  32.     Versão Atual: 1.4
  33.  
  34.     Alterada em: 13/03/05
  35.  
  36.     Alterações:
  37.         • nova forma de uso (inclusão) para uso de UArquivoLog versão 1.2
  38.         • nome alterado para ArquivoDireto, evitando conflito com versões
  39.           anteriores a 19/02/05 e forçando a migração hard-coded
  40.         • propriedade Nome alterada para published para futuro componente
  41.  
  42.     Versões Anteriores:
  43.         • 1.3: 19/02/05 • Ricardo Erick Rebêlo
  44.           • inversão da forma de retorno de erros (true = erro)
  45.           • possibilitação de criptografia "mochila":
  46.             SetSementes agora pode ser chamada com o arquivo aberto!
  47.  
  48.         • 1.2: 03/02/05 • Ricardo Erick Rebêlo
  49.           • incluídas as funções Grava64, Le64, GravaDouble e LeDouble
  50.             para uso no módulo TryToCopy versão 0.2
  51.  
  52.         • 1.1: 22/05/04 • Ricardo Erick Rebêlo
  53.           • bugs corrigidos e comentários acrescentados
  54.           • incluídas as funções GravaStringFixa e LeStringFixa
  55.  
  56.         • 1.0: 04/08/03 • Ricardo Erick Rebêlo
  57.  
  58.     Métodos:
  59. Const   Cria: cria o objeto, sem nome de arquivo (overload)
  60. Const   Cria( nome): cria o objeto, com nome de arquivo (overload)
  61. Destr   Destroi: destrói o objeto, fechando o arquivo, se estiver aberto
  62.     Fecha: fecha o arquivo, se estiver aberto - retorna erros
  63.     Grava: abre o arquivo para gravação - retorna erros (overload)
  64.     Grava( nome): idem, entra com (novo) nome do arquivo (overload)
  65.     Grava64( i): grava um número inteiro de 64bits - retorna erros - versão 1.2 em diante
  66.     GravaBoolean( b): grava um boolean - retorna erros
  67.     GravaDouble( r): grava um número double - retorna erros - versão 1.2 em diante
  68.     GravaInteiro( i): grava um número inteiro - retorna erros
  69.     GravaReal( r): grava um número real - retorna erros
  70.     GravaString( s): grava uma string de tamanho variável - retorna erros
  71.     GravaStringFixa( s, t): grava uma string de tamanho t - retorna erros - versão 1.1 em diante
  72.     Inclui: abre o arquivo para gravação (inclusão) - retorna erros (overload) - versão 1.4 em diante
  73.     Inclui( nome): idem, entra com (novo) nome do arquivo (overload) - versão 1.4 em diante
  74.     Le: abre o arquivo para leitura - retorna erros (overload)
  75.     Le( nome): idem, entra com (novo) nome do arquivo (overload)
  76.     Le64(var i): lê um número inteiro de 64bits - retorna erros - versão 1.2 em diante
  77.     LeBoolean( var b): lê um boolean - retorna erros
  78.     LeDouble( var r): lê um número double - retorna erros - versão 1.2 em diante
  79.     LeInteiro( var i): lê um número inteiro - retorna erros
  80.     LeReal( var r): lê um número real - retorna erros
  81.     LeString( var s): lê uma string de tamanho variável - retorna erros
  82.     LeStringFixa( var s, t): lê uma string de tamanho t - retorna erros - versão 1.1 em diante
  83.     SetSementes( i, b, r): seta as sementes de criptografia
  84.     ResetSementes: retira as sementes (sem criptografia)
  85.  
  86.     Propriedades:
  87.     nome (rw): nome do arquivo - verificar erro logo após a escrita (w) (publicada da versão 1.4 em diante)
  88.     erro (r): dado do tipo TEErroArquivo indicando o erro que ocorreu
  89.                   quando uma função que retorna erros retorna true
  90.               (uma função que retorna erros retorna falso quando não houve erro)
  91.           (o retorno nas versões anteriores a 1.3 é invertido!)
  92.     modo (r): dado do tipo TEModoArquivo indicando o modo do arquivo
  93.               (TMFechado, TMLeitura, TMGravacao, TMInclusao - versão 1.4 em diante)
  94.  
  95.     Privados:
  96.         procedure SetNome( nome): modifica o nome do arquivo (escrita da propriedade nome)
  97.         SArquivo (file): número do arquivo, usado nas funções de I/O
  98.         SErro (TEErroArquivo): dado interno indicando o último erro
  99.         SModo (TEModoArquivo): dado interno indicando o modo do arquivo
  100.         SNome (string): nome interno do arquivo, privado por causa da escrita
  101.         SSementes (boolean): indica se existem sementes de criptografia simples
  102.         SSementeInteiro (integer): semente de criptografia simples para inteiros
  103.         SSementeReal (real): semente de criptografia simples para reais
  104.         SSementeString (byte): semente de criptografia simples para strings - não usada em boolean
  105.  
  106.     Exemplo de Uso:
  107.     (veja UArquivoLog 1.2)
  108.  
  109.     Outras Informações:
  110.         • O arquivo gerado por TArquivoDireto não é estruturado. Para ler este
  111.           arquivo, o aplicativo tem que se responsabilizar pela ordem dos dados.
  112.           Use a regra FIFO - First In, First Out - primeira entrada, primeira saída!
  113.  
  114.         • WideString não é suportada nesta versão. Não use typecast, pois
  115.           as WideStrings serão truncadas nas duas versões de GravaString.
  116.           Caso você precise usar WideStrings, copie e altere os códigos dos
  117.           métodos que usam strings que mais lhe convier.
  118.  
  119.         • Embora teoricamente seja possível gravar strings de até 2GB, tente não usar
  120.           strings muito maiores que 64KB, por questões de eficiência e uso de memória.
  121.  
  122.         • Tamanhos (DELPHI 5)*:
  123.             boolean:    01 byte
  124.             double:     08 bytes
  125.             integer:    04 bytes
  126.             int64:      08 bytes
  127.             real:       06 bytes
  128.             string:     04 bytes + tamanho da string
  129.             stringfixa: tamanho da string
  130.         * os tamanhos podem se alterar em versões posteriores e são diferentes
  131.           em versões anteriores para real, integer e string.
  132. }
  133.  
  134.  
  135. {
  136.     Autor: Ricardo Erick Rebelo
  137.     Versão: 1.4 (quarta versão da primeira implementação)
  138.     Última Modificação: 13/03/05 por Ricardo Erick Rebêlo
  139.     Documentação: UArquivoDireto.txt
  140.  
  141.     AVISO: não substituir nos projetos anteriores a 19/02/05
  142. }
  143.  
  144. unit UArquivoDireto;
  145.  
  146. interface
  147.  
  148. uses UTipos; {para usar TEModoArquivo e TEErroArquivo}
  149.  
  150. type
  151.  
  152. { ############### TArquivoDireto ############### }
  153.  
  154.   TArquivoDireto = class
  155.   private
  156.     SNome: string;
  157.     SArquivo: file;
  158.     SModo: TEModoArquivo;
  159.     SErro: TEErroArquivo;
  160.     SSementes: Boolean;
  161.     SSementeInteiro: integer;
  162.     SSementeString: byte;
  163.     SSementeReal: real;
  164.     procedure   SetNome( nome: string);
  165.   public
  166.     constructor Cria; overload;
  167.     constructor Cria( nome: string); overload;
  168.     destructor  Destroi;
  169.     function    Grava: boolean; overload;
  170.     function    Grava( nome: string): boolean; overload;
  171. //===========================================
  172.     function    Inclui: boolean; overload;
  173.     function    Inclui( nome: string): boolean; overload;
  174. {============================================
  175.       INCLUÍDAS PARA PERMITIR NOVA FORMA DE USO (INCLUSÃO) (12/03/05) }
  176.     function    Le: boolean; overload;
  177.     function    Le( nome: string): boolean; overload;
  178.     function    Fecha: boolean;
  179.     function    GravaInteiro( i: integer): boolean;
  180.     function    LeInteiro( var i: integer): boolean;
  181.     function    GravaString( s: string): boolean;
  182.     function    LeString( var s: string): boolean;
  183.     function    GravaBoolean( b: boolean): boolean;
  184.     function    LeBoolean( var b: boolean): boolean;
  185.     function    GravaReal( r: real): boolean;
  186.     function    LeReal( var r: real): boolean;
  187.     function    GravaStringFixa( s: string; t: integer): boolean; // versão 1.1
  188.     function    LeStringFixa( var s: string; t: integer): boolean; // versão 1.1
  189. //===========================================
  190.     function    Grava64( i: int64): boolean;
  191.     function    Le64( var i: int64): boolean;
  192.     function    GravaDouble( r: double): boolean;
  193.     function    LeDouble( var r: double): boolean;
  194. {============================================
  195.       INCLUÍDAS PARA USO DO TRYTOCOPY (03/02/05) }
  196.     procedure   SetSementes( i: integer; b: byte; r: real);
  197.     procedure   ResetSementes;
  198.     property erro: TEErroArquivo read SErro;
  199.     property modo: TEModoArquivo read SModo;
  200.   published
  201.     property nome: string read SNome write SetNome;
  202.   end;
  203.  
  204. {############################################
  205. #   I  M  P  L  E  M  E  N  T  A  Ç  Ã  O   #
  206. ############################################}
  207.  
  208. implementation
  209.  
  210. uses sysutils; {para usar rotinas de I/O}
  211.  
  212. { ############### TArquivoDireto ############### }
  213.  
  214. //=====================================
  215.  
  216. constructor TArquivoDireto.Cria;
  217. begin
  218.   SNome := '';
  219.   SModo := TMFechado;
  220.   SErro := TENenhum;
  221.   SSementes := False;
  222. end; {cria o arquivo (sem abrir) e zera atributos}
  223.  
  224. //=====================================
  225.  
  226. constructor TArquivoDireto.Cria(nome: string);
  227. begin
  228.   Cria;
  229.   SNome := nome;
  230. end; {cria o arquivo (sem abrir) e seta nome}
  231.  
  232. //=====================================
  233.  
  234. destructor TArquivoDireto.Destroi;
  235. begin
  236.   if SModo <> TMFechado then
  237.   begin
  238.     {$I-}
  239.     CloseFile( SArquivo);
  240.     {$I+}
  241.   end;
  242. end; {destrói o arquivo (fechando se possível)}
  243.  
  244. //=====================================
  245.  
  246. function TArquivoDireto.Fecha: boolean;
  247. begin
  248.   if SModo <> TMFechado then
  249.   begin
  250.     {$I-}
  251.     CloseFile( SArquivo);
  252.     {$I+}
  253.     if IOResult = 0 then
  254.     begin
  255.       SErro := TENenhum;
  256.       SModo := TMFechado;
  257.       Fecha := False;
  258.     end else begin
  259.       SErro := TEErroIO;
  260.       Fecha := True;
  261.     end;
  262.   end else begin
  263.     SErro := TEArquivoFechado;
  264.     Fecha := True;
  265.   end;
  266. end;  {tenta fechar o arquivo e retorna true se não consegue - alterado em 19/02/05}
  267.  
  268. //=====================================
  269.  
  270. function TArquivoDireto.Grava(nome: string): boolean;
  271. begin
  272.   if SModo <> TMFechado then
  273.   begin
  274.     SErro := TEArquivoAberto;
  275.     Grava := True;
  276.   end else begin
  277.     if nome = '' then
  278.     begin
  279.       SErro := TESemNome;
  280.       Grava := True;
  281.     end else begin
  282.       AssignFile( SArquivo, nome);
  283.       {$I-}
  284.       ReWrite( SArquivo, 1);
  285.       {$I+}
  286.       if IOResult = 0 then
  287.       begin
  288.         SNome := nome;
  289.         SErro := TENenhum;
  290.         SModo := TMGravacao;
  291.         Grava := False;
  292.       end else begin
  293.         SErro := TEErroIO;
  294.         Grava := True;
  295.       end;
  296.     end;
  297.   end;
  298. end; {abre para gravação (se arquivo estiver fechado!)}
  299.  
  300. //=====================================
  301.  
  302. function TArquivoDireto.Grava: boolean;
  303. begin
  304.   if SModo <> TMFechado then
  305.   begin
  306.     SErro := TEArquivoAberto;
  307.     Grava := True;
  308.   end else begin
  309.     if SNome = '' then
  310.     begin
  311.       SErro := TESemNome;
  312.       Grava := True;
  313.     end else begin
  314.       AssignFile( SArquivo, SNome);
  315.       {$I-}
  316.       ReWrite( SArquivo, 1);
  317.       {$I+}
  318.       if IOResult = 0 then
  319.       begin
  320.         SErro := TENenhum;
  321.         SModo := TMGravacao;
  322.         Grava := False;
  323.       end else begin
  324.         SErro := TEErroIO;
  325.         Grava := True;
  326.       end;
  327.     end;
  328.   end;
  329. end; {abre para gravação (se arquivo estiver fechado!)}
  330.  
  331. //=====================================
  332.  
  333. function TArquivoDireto.GravaBoolean(b: boolean): boolean;
  334. begin
  335.   if (SModo <> TMGravacao) and (SModo <> TMInclusao) then  // 12/03/05 > Inclusão
  336.   begin
  337.     SErro := TEModoDiferente;
  338.     GravaBoolean := True;
  339.   end else begin
  340.     {$I-}
  341.     BlockWrite( SArquivo, b, sizeof( b));
  342.     {$I+}
  343.     if IOResult = 0 then
  344.     begin
  345.       SErro := TENenhum;
  346.       GravaBoolean := False;
  347.     end else begin
  348.       SErro := TEErroIO;
  349.       GravaBoolean := True;
  350.     end;
  351.   end;
  352. end; {salva um valor boolean (se arquivo estiver estiver em gravação ou inclusão)}
  353.  
  354. //=====================================
  355.  
  356. function TArquivoDireto.GravaInteiro(i: integer): boolean;
  357. begin
  358.   if (SModo <> TMGravacao) and (SModo <> TMInclusao) then  // 12/03/05 > Inclusão
  359.   begin
  360.     SErro := TEModoDiferente;
  361.     GravaInteiro := True;
  362.   end else begin
  363.     {$I-}
  364.     if SSementes then i := SSementeInteiro - i;
  365.     BlockWrite( SArquivo, i, sizeof( i));
  366.     {$I+}
  367.     if IOResult = 0 then
  368.     begin
  369.       SErro := TENenhum;
  370.       GravaInteiro := False;
  371.     end else begin
  372.       SErro := TEErroIO;
  373.       GravaInteiro := True;
  374.     end;
  375.   end;
  376. end; {salva um valor inteiro (se arquivo estiver estiver em gravação ou inclusão)}
  377.  
  378. //===================================== VERSÃO 1.2 (03/02/05)
  379.  
  380. function TArquivoDireto.Grava64(i: int64): boolean;
  381. begin
  382.   if (SModo <> TMGravacao) and (SModo <> TMInclusao) then  // 12/03/05 > Inclusão
  383.   begin
  384.     SErro := TEModoDiferente;
  385.     Grava64 := True;
  386.   end else begin
  387.     {$I-}
  388.     if SSementes then i := SSementeInteiro - i;
  389.     BlockWrite( SArquivo, i, sizeof( i));
  390.     {$I+}
  391.     if IOResult = 0 then
  392.     begin
  393.       SErro := TENenhum;
  394.       Grava64 := False;
  395.     end else begin
  396.       SErro := TEErroIO;
  397.       Grava64 := True;
  398.     end;
  399.   end;
  400. end; {salva um valor int64 (se arquivo estiver estiver em gravação ou inclusão)}
  401.  
  402. //=====================================
  403.  
  404. function TArquivoDireto.GravaReal(r: real): boolean;
  405. begin
  406.   if (SModo <> TMGravacao) and (SModo <> TMInclusao) then  // 12/03/05 > Inclusão
  407.   begin
  408.     SErro := TEModoDiferente;
  409.     GravaReal := True;
  410.   end else begin
  411.     {$I-}
  412.     if SSementes then r := SSementeReal - r;
  413.     BlockWrite( SArquivo, r, sizeof( r));
  414.     {$I+}
  415.     if IOResult = 0 then
  416.     begin
  417.       SErro := TENenhum;
  418.       GravaReal := False;
  419.     end else begin
  420.       SErro := TEErroIO;
  421.       GravaReal := True;
  422.     end;
  423.   end;
  424. end; {salva um valor real (se arquivo estiver estiver em gravação ou inclusão)}
  425.  
  426. //===================================== VERSÃO 1.2 (03/02/05)
  427.  
  428. function TArquivoDireto.GravaDouble(r: double): boolean;
  429. begin
  430.   if (SModo <> TMGravacao) and (SModo <> TMInclusao) then  // 12/03/05 > Inclusão
  431.   begin
  432.     SErro := TEModoDiferente;
  433.     GravaDouble := False;
  434.   end else begin
  435.     {$I-}
  436.     if SSementes then r := SSementeReal - r;
  437.     BlockWrite( SArquivo, r, sizeof( r));
  438.     {$I+}
  439.     if IOResult = 0 then
  440.     begin
  441.       SErro := TENenhum;
  442.       GravaDouble := True;
  443.     end else begin
  444.       SErro := TEErroIO;
  445.       GravaDouble := False;
  446.     end;
  447.   end;
  448. end; {salva um valor double (se arquivo estiver estiver em gravação ou inclusão)}
  449.  
  450. //=====================================
  451.  
  452. function TArquivoDireto.GravaString(s: string): boolean;
  453. var
  454.   c, t: integer;
  455.   a: char;
  456. begin
  457.   if (SModo <> TMGravacao) and (SModo <> TMInclusao) then  // 12/03/05 > Inclusão
  458.   begin
  459.     SErro := TEModoDiferente;
  460.     GravaString := True;
  461.   end else begin
  462.     t := Length( s);
  463.     if GravaInteiro ( t) then
  464.     begin
  465.       GravaString := True;
  466.       Exit; {nesse caso, SErro será igual o que GravaInteiro gerou, TEErroIO provavelmente}
  467.     end;
  468.     for c := 1 to t do
  469.     begin
  470.       {$I-}
  471.       a := s[c];
  472.       if SSementes then Inc(a, SSementeString);
  473.       BlockWrite( SArquivo, a, sizeof( a));
  474.       {$I+}
  475.       if IOResult <> 0 then
  476.       begin
  477.         SErro := TEErroIO;
  478.         GravaString := True;
  479.         Exit;
  480.       end;
  481.     end;
  482.     SErro := TENenhum;
  483.     GravaString := False;
  484.   end;
  485. end; {salva uma string de tamanho variável (se arquivo estiver estiver em gravação ou inclusão)}
  486.  
  487. //===================================== VERSÃO 1.1 (22/05/04)
  488.  
  489. function TArquivoDireto.GravaStringFixa(s: string; t: integer): boolean;
  490. var
  491.   c: integer;
  492.   a: char;
  493. begin
  494.   if (SModo <> TMGravacao) and (SModo <> TMInclusao) then  // 12/03/05 > Inclusão
  495.   begin
  496.     SErro := TEModoDiferente;
  497.     GravaStringFixa := True;
  498.   end else begin
  499.     for c := 1 to t do
  500.     begin
  501.       {$I-}
  502.       if c <= Length( s) then a := s[c] else a := ' ';
  503.       if SSementes then Inc(a, SSementeString);
  504.       BlockWrite( SArquivo, a, sizeof( a));
  505.       {$I+}
  506.       if IOResult <> 0 then
  507.       begin
  508.         SErro := TEErroIO;
  509.         GravaStringFixa := True;
  510.         Exit;
  511.       end;
  512.     end;
  513.     SErro := TENenhum;
  514.     GravaStringFixa := False;
  515.   end;
  516. end; {salva uma string de tamanho fixo (se arquivo estiver estiver em gravação ou inclusão)}
  517.  
  518. //=====================================
  519.  
  520. function TArquivoDireto.Le(nome: string): boolean;
  521. begin
  522.   if SModo <> TMFechado then
  523.   begin
  524.     SErro := TEArquivoAberto;
  525.     Le := True;
  526.   end else begin
  527.     AssignFile( SArquivo, nome);
  528.     {$I-}
  529.     Reset( SArquivo, 1);
  530.     {$I+}
  531.     if IOResult = 0 then
  532.     begin
  533.       SNome := nome;
  534.       SErro := TENenhum;
  535.       SModo := TMLeitura;
  536.       Le := False;
  537.     end else begin
  538.       SErro := TEErroIO;
  539.       Le := True;
  540.     end;
  541.   end;
  542. end; {abre para leitura (se arquivo estiver fechado!)}
  543.  
  544. //=====================================
  545.  
  546. function TArquivoDireto.Le: boolean;
  547. begin
  548.   if SModo <> TMFechado then
  549.   begin
  550.     SErro := TEArquivoAberto;
  551.     Le := True;
  552.   end else begin
  553.     if SNome = '' then
  554.     begin
  555.       SErro := TESemNome;
  556.       Le := True;
  557.     end else begin
  558.       AssignFile( SArquivo, SNome);
  559.       {$I-}
  560.       Reset( SArquivo, 1);
  561.       {$I+}
  562.       if IOResult = 0 then
  563.       begin
  564.         SErro := TENenhum;
  565.         SModo := TMLeitura;
  566.         Le := False;
  567.       end else begin
  568.         SErro := TEErroIO;
  569.         Le := True;
  570.       end;
  571.     end;
  572.   end;
  573. end; {abre para leitura (se arquivo estiver fechado!)}
  574.  
  575. //=====================================
  576.  
  577. function TArquivoDireto.LeBoolean(var b: boolean): boolean;
  578. begin
  579.   if SModo <> TMLeitura then
  580.   begin
  581.     SErro := TEModoDiferente;
  582.     LeBoolean := True;
  583.   end else begin
  584.     {$I-}
  585.     BlockRead( SArquivo, b, sizeof( b));
  586.     {$I+}
  587.     if IOResult = 0 then
  588.     begin
  589.       SErro := TENenhum;
  590.       LeBoolean := False;
  591.     end else begin
  592.       SErro := TEErroIO;
  593.       LeBoolean := True;
  594.     end;
  595.   end;
  596. end; {lê um valor boolean (se arquivo estiver estiver em leitura)}
  597.  
  598. //=====================================
  599.  
  600. function TArquivoDireto.LeInteiro(var i: integer): boolean;
  601. begin
  602.   if SModo <> TMLeitura then
  603.   begin
  604.     SErro := TEModoDiferente;
  605.     LeInteiro := True;
  606.   end else begin
  607.     {$I-}
  608.     BlockRead( SArquivo, i, sizeof( i));
  609.     if SSementes then i := SSementeInteiro - i;
  610.     {$I+}
  611.     if IOResult = 0 then
  612.     begin
  613.       SErro := TENenhum;
  614.       LeInteiro := False;
  615.     end else begin
  616.       SErro := TEErroIO;
  617.       LeInteiro := True;
  618.     end;
  619.   end;
  620. end; {lê um valor inteiro (se arquivo estiver estiver em leitura)}
  621.  
  622. //===================================== VERSÃO 1.2 (03/02/05)
  623.  
  624. function TArquivoDireto.Le64(var i: int64): boolean;
  625. begin
  626.   if SModo <> TMLeitura then
  627.   begin
  628.     SErro := TEModoDiferente;
  629.     Le64 := True;
  630.   end else begin
  631.     {$I-}
  632.     BlockRead( SArquivo, i, sizeof( i));
  633.     if SSementes then i := SSementeInteiro - i;
  634.     {$I+}
  635.     if IOResult = 0 then
  636.     begin
  637.       SErro := TENenhum;
  638.       Le64 := False;
  639.     end else begin
  640.       SErro := TEErroIO;
  641.       Le64 := True;
  642.     end;
  643.   end;
  644. end; {lê um valor int64 (se arquivo estiver estiver em leitura)}
  645.  
  646. //=====================================
  647.  
  648. function TArquivoDireto.LeReal(var r: real): boolean;
  649. begin
  650.   if SModo <> TMLeitura then
  651.   begin
  652.     SErro := TEModoDiferente;
  653.     LeReal := True;
  654.   end else begin
  655.     {$I-}
  656.     BlockRead( SArquivo, r, sizeof( r));
  657.     if SSementes then r := SSementeReal - r;
  658.     {$I+}
  659.     if IOResult = 0 then
  660.     begin
  661.       SErro := TENenhum;
  662.       LeReal := False;
  663.     end else begin
  664.       SErro := TEErroIO;
  665.       LeReal := True;
  666.     end;
  667.   end;
  668. end; {lê um valor real (se arquivo estiver estiver em leitura)}
  669.  
  670. //===================================== VERSÃO 1.2 (03/02/05)
  671.  
  672. function TArquivoDireto.LeDouble(var r: double): boolean;
  673. begin
  674.   if SModo <> TMLeitura then
  675.   begin
  676.     SErro := TEModoDiferente;
  677.     LeDouble := True;
  678.   end else begin
  679.     {$I-}
  680.     BlockRead( SArquivo, r, sizeof( r));
  681.     if SSementes then r := SSementeReal - r;
  682.     {$I+}
  683.     if IOResult = 0 then
  684.     begin
  685.       SErro := TENenhum;
  686.       LeDouble := False;
  687.     end else begin
  688.       SErro := TEErroIO;
  689.       LeDouble := True;
  690.     end;
  691.   end;
  692. end; {lê um valor double (se arquivo estiver estiver em leitura)}
  693.  
  694. //=====================================
  695.  
  696. function TArquivoDireto.LeString(var s: string): boolean;
  697. var
  698.   c, t: integer;
  699.   a: char;
  700. begin
  701.   if SModo <> TMLeitura then
  702.   begin
  703.     SErro := TEModoDiferente;
  704.     LeString := True;
  705.   end else begin
  706.     if LeInteiro ( t) then
  707.     begin
  708.       LeString := True;
  709.       Exit; {nesse caso, SErro será igual o que LeInteiro gerou, TEErroIO provavelmente}
  710.     end;
  711.     try
  712.       SetLength( s, t);
  713.     except
  714.       on E: Exception do
  715.       begin
  716.         SErro := TEMemoria;
  717.         LeString := True;
  718.         Exit;
  719.       end;
  720.     end;
  721.     for c := 1 to t do
  722.     begin
  723.       {$I-}
  724.       BlockRead( SArquivo, a, sizeof( a));
  725.       if SSementes then Dec(a, SSementeString);
  726.       s[c] := a;
  727.       {$I+}
  728.       if IOResult <> 0 then
  729.       begin
  730.         SErro := TEErroIO;
  731.         LeString := True;
  732.         Exit;
  733.       end;
  734.     end;
  735.     SErro := TENenhum;
  736.     LeString := False;
  737.   end;
  738. end; {lê uma string de tamanho variável (se arquivo estiver estiver em leitura)}
  739.  
  740. //===================================== VERSÃO 1.1 (22/05/04)
  741.  
  742. function TArquivoDireto.LeStringFixa(var s: string; t: integer): boolean;
  743. var
  744.   c: integer;
  745.   a: char;
  746. begin
  747.   if SModo <> TMLeitura then
  748.   begin
  749.     SErro := TEModoDiferente;
  750.     LeStringFixa := True;
  751.   end else begin
  752.     try
  753.       SetLength( s, t);
  754.     except
  755.       on E: Exception do
  756.       begin
  757.         SErro := TEMemoria;
  758.         LeStringFixa := True;
  759.         Exit;
  760.       end;
  761.     end;
  762.     for c := 1 to t do
  763.     begin
  764.       {$I-}
  765.       BlockRead( SArquivo, a, sizeof( a));
  766.       if SSementes then Dec(a, SSementeString);
  767.       s[c] := a;
  768.       {$I+}
  769.       if IOResult <> 0 then
  770.       begin
  771.         SErro := TEErroIO;
  772.         LeStringFixa := True;
  773.         Exit;
  774.       end;
  775.     end;
  776.     SErro := TENenhum;
  777.     LeStringFixa := False;
  778.   end;
  779. end; {lê uma string de tamanho fixo (se arquivo estiver estiver em leitura)}
  780.  
  781. //=====================================
  782.  
  783. procedure TArquivoDireto.ResetSementes;
  784. begin
  785. {  if SModo <> TMFechado then
  786.   begin
  787.     SErro := TEArquivoAberto;
  788.     ResetSementes := True;
  789.   end else begin}                  // Alteração feita para permitir criptografia "mochila"  (19/02/05 - Ricardo Erick Rebêlo)
  790.     SSementes := False;
  791.     SErro := TENenhum;
  792. {  end;}
  793. end; {deixa de usar criptografia básica}
  794.  
  795. //=====================================
  796.  
  797. procedure TArquivoDireto.SetNome(nome: string);
  798. begin
  799.   if SModo <> TMFechado then
  800.   begin
  801.     SErro := TEArquivoAberto;
  802.   end else begin
  803.     SErro := TENenhum;
  804.     SNome := nome;
  805.   end;
  806. end;
  807.  
  808. //=====================================
  809.  
  810. procedure TArquivoDireto.SetSementes(i: integer; b: byte; r: real);
  811. begin
  812. {  if SModo <> TMFechado then
  813.   begin
  814.     SErro := TEArquivoAberto;
  815.     SetSementes := False;
  816.   end else begin}                  // Alteração feita para permitir criptografia "mochila"  (19/02/05 - Ricardo Erick Rebêlo)
  817.     SSementeInteiro := i;
  818.     SSementeString := b;
  819.     SSementeReal := r;
  820.     SSementes := True;
  821.     SErro := TENenhum;
  822.   {end;}
  823. end; {passa a usar criptografia básica}
  824.  
  825. //===================================== VERSÃO 1.4 (12/03/05)
  826.  
  827. function TArquivoDireto.Inclui(nome: string): boolean;
  828. begin
  829.   if SModo <> TMFechado then
  830.   begin
  831.     SErro := TEArquivoAberto;
  832.     Inclui := True;
  833.   end else begin
  834.     AssignFile( SArquivo, nome);
  835.     {$I-}
  836.     Reset( SArquivo, 1);
  837.     Seek( SArquivo, FileSize( SArquivo));
  838.     {$I+}
  839.     if IOResult = 0 then
  840.     begin
  841.       SNome := nome;
  842.       SErro := TENenhum;
  843.       SModo := TMInclusao;
  844.       Inclui := False;
  845.     end else begin
  846.       SErro := TEErroIO;
  847.       Inclui := True;
  848.     end;
  849.   end;
  850. end; {abre para inclusão (se arquivo estiver fechado!)}
  851.  
  852. //===================================== VERSÃO 1.4 (12/03/05)
  853.  
  854. function TArquivoDireto.Inclui: boolean;
  855. begin
  856.   if SModo <> TMFechado then
  857.   begin
  858.     SErro := TEArquivoAberto;
  859.     Inclui := True;
  860.   end else begin
  861.     if SNome = '' then
  862.     begin
  863.       SErro := TESemNome;
  864.       Inclui := True;
  865.     end else begin
  866.       AssignFile( SArquivo, nome);
  867.       {$I-}
  868.       Reset( SArquivo, 1);
  869.       Seek( SArquivo, FileSize( SArquivo));
  870.       {$I+}
  871.       if IOResult = 0 then
  872.       begin
  873.         SErro := TENenhum;
  874.         SModo := TMInclusao;
  875.         Inclui := False;
  876.       end else begin
  877.         SErro := TEErroIO;
  878.         Inclui := True;
  879.       end;
  880.     end;
  881.   end;
  882. end; {abre para inclusão (se arquivo estiver fechado!)}
  883.  
  884. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement