Explorar o código

Merged revisions 2967,2992-2993,3019,3121,3142,3158,3163,3188,3208,3220-3221 via svnmerge from
http://[email protected]/svn/fpc/trunk

........
r2967 | florian | 2006-03-19 14:40:48 +0100 (Sun, 19 Mar 2006) | 2 lines

* svn:executable

........
r2992 | florian | 2006-03-20 22:20:55 +0100 (Mon, 20 Mar 2006) | 2 lines

* "merged" pthread fixes from rtl

........
r2993 | florian | 2006-03-20 23:14:22 +0100 (Mon, 20 Mar 2006) | 2 lines

* some cleanup

........
r3019 | jonas | 2006-03-23 15:24:49 +0100 (Thu, 23 Mar 2006) | 2 lines

* fixed web bug #4934

........
r3121 | michael | 2006-04-02 10:25:36 +0200 (Sun, 02 Apr 2006) | 1 line

+ Support for loading arbitrary libraries, preserved default behaviour
........
r3142 | mattias | 2006-04-04 20:05:15 +0200 (Tue, 04 Apr 2006) | 1 line

added gtk2 functions gtk_tree_view_column_set_expand and gtk_tree_view_column_get_expand from Zhong
........
r3158 | michael | 2006-04-06 10:50:32 +0200 (Thu, 06 Apr 2006) | 1 line

+ Library to be loaded is now selectable
........
r3163 | michael | 2006-04-07 15:08:01 +0200 (Fri, 07 Apr 2006) | 1 line

+ Removed debug statement
........
r3188 | michael | 2006-04-09 23:34:16 +0200 (Sun, 09 Apr 2006) | 2 lines

* fixed library name for shm_unlink,shm_open as per mariano podesta's suggestion.

........
r3208 | daniel | 2006-04-14 16:59:35 +0200 (Fri, 14 Apr 2006) | 2 lines

* Fix integer overflow bug.

........
r3220 | armin | 2006-04-15 21:59:19 +0200 (Sat, 15 Apr 2006) | 2 lines

added sysutils for debug

........
r3221 | armin | 2006-04-15 22:24:12 +0200 (Sat, 15 Apr 2006) | 2 lines

renamed DEBUG to ZLIB_DEBUG

........

git-svn-id: branches/fixes_2_0@3264 -

peter %!s(int64=19) %!d(string=hai) anos
pai
achega
da7dade6d1

+ 55 - 28
packages/base/ibase/ibase60.inc

@@ -2455,33 +2455,28 @@ implementation
 
 {$IFDEF LinkDynamically}
 
-var RefCount : integer;
-
-Procedure InitialiseIBase60;
+ResourceString
+  SErrEmbeddedFailed = 'Can not load embedded Firebird client "%s". Check your installation.';
+  SErrDefaultsFailed = 'Can not load default Firebird clients ("%s" or "%s"). Check your installation.';
+  SErrLoadFailed     = 'Can not load Firebird client library "%s". Check your installation.';
+  SErrAlreadyLoaded  = 'Firebird interface already initialized from library %s.';
+  
+var 
+  RefCount : integer;
+  LoadedLibrary : String;
+
+Function TryInitialiseIBase60(Const LibraryName : String) : Boolean;
 
 begin
-  inc(RefCount);
-  if RefCount = 1 then
+  Result:=False;
+  if (RefCount=0) then
     begin
-    If UseEmbeddedFirebird then
-      begin
-      IBaseLibraryHandle:=loadlibrary(fbembedlib);
-      if (IBaseLibraryHandle=nilhandle) then
-        Raise EInOutError.Create('Can not load Firebird Embedded client. Is it installed? ('+fbembedlib+')');
-      end
-    else 
-      begin
-      IBaseLibraryHandle:=loadlibrary(fbclib);
-      if (IBaseLibraryHandle=nilhandle) then
-        begin
-        IBaseLibraryHandle:=loadlibrary(gdslib);
-        if (IBaseLibraryHandle=nilhandle) then
-          begin
-          RefCount := 0;
-          Raise EInOutError.Create('Can not load Firebird or Interbase client. Is it installed? ('+gdslib+' or '+fbclib+')');
-          end;
-        end;
-      end;  
+    IBaseLibraryHandle:=LoadLibrary(LibraryName);
+    Result:=(IBaseLibraryHandle<>nilhandle);
+    If not Result then
+      Exit;
+    inc(RefCount);
+    LoadedLibrary:=LibraryName;
     pointer(isc_attach_database) := GetProcedureAddress(IBaseLibraryHandle,'isc_attach_database');
     pointer(isc_array_gen_sdl) := GetProcedureAddress(IBaseLibraryHandle,'isc_array_gen_sdl');
     pointer(isc_array_get_slice) := GetProcedureAddress(IBaseLibraryHandle,'isc_array_get_slice');
@@ -2648,16 +2643,48 @@ begin
     pointer(isc_reset_form) := GetProcedureAddress(IBaseLibraryHandle,'isc_reset_form');
     pointer(isc_suspend_window) := GetProcedureAddress(IBaseLibraryHandle,'isc_suspend_window');
 {$ENDIF}
-    end;
+    end
+  else
+    begin
+    If (LoadedLibrary<>LibraryName) then
+      Raise EInoutError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+    Result:=True;
+    end;  
+end;
+
+Procedure InitialiseIBase60;
+
+begin
+  If UseEmbeddedFirebird then
+    begin
+    If Not TryInitialiseIBase60(fbembedlib) then
+      Raise EInOutError.CreateFmt(SErrEmbeddedFailed,[fbembedlib]);
+    end
+  else
+    begin
+    If (Not TryInitialiseIBase60(fbclib)) and
+       (Not TryInitialiseIBase60(gdslib)) then
+        Raise EInOutError.CreateFmt(SErrDefaultsFailed,[gdslib,fbclib]);
+    end;    
+end;
+
+Procedure InitialiseIBase60(Const LibraryName : String);
+
+begin
+  If Not TryInitialiseIbase60(LibraryName) then
+    Raise EInOutError.CreateFmt(SErrLoadFailed,[LibraryName]);
 end;
 
+
 Procedure ReleaseIBase60;
 
 begin
-  if RefCount > 0 then dec(RefCount);
-  if RefCount = 0 then
+  if RefCount>1 then
+    Dec(RefCount)
+  else if UnloadLibrary(IBaseLibraryHandle) then 
     begin
-    if not UnloadLibrary(IBaseLibraryHandle) then inc(RefCount);
+    Dec(RefCount);
+    LoadedLibrary:='';
     end;
 end;
 

+ 4 - 2
packages/base/libc/smmaph.inc

@@ -3,6 +3,8 @@
 Const
   MAP_FAILED = pointer(-1);
 
+Const
+  rtlib = 'rt';
 
 function mmap(__addr:pointer; __len:size_t; __prot:longint; __flags:longint; __fd:longint;
            __offset:__off_t):pointer;cdecl;external clib name 'mmap';
@@ -19,8 +21,8 @@ function mlockall(__flags:longint):longint;cdecl;external clib name 'mlockall';
 function munlockall:longint;cdecl;external clib name 'munlockall';
 function mremap(__addr:pointer; __old_len:size_t; __new_len:size_t; __may_move:longint):pointer;cdecl;external clib name 'mremap';
 function mincore(__start:pointer; __len:size_t; __vec:Pbyte):longint;cdecl;external clib name 'mincore';
-function shm_open(__name:Pchar; __oflag:longint; __mode:mode_t):longint;cdecl;external clib name 'shm_open';
-function shm_unlink(__name:Pchar):longint;cdecl;external clib name 'shm_unlink';
+function shm_open(__name:Pchar; __oflag:longint; __mode:mode_t):longint;cdecl;external rtlib name 'shm_open';
+function shm_unlink(__name:Pchar):longint;cdecl;external rtlib name 'shm_unlink';
 
 
 { ---------------------------------------------------------------------

+ 135 - 114
packages/base/mysql/mkdb

@@ -1473,142 +1473,163 @@ uses
 {$endif}
 
 {$IFDEF LinkDynamically}
-Procedure InitialiseMysql;
+Function InitialiseMysql(Const LibraryName : String) : Integer;
+Function InitialiseMysql : Integer;
 Procedure ReleaseMysql;
 
-var Mysql4LibraryHandle : TLibHandle;
+var MysqlLibraryHandle : TLibHandle;
 {$ENDIF}
 
 implementation
 
 {$IFDEF LinkDynamically}
 
-var RefCount : integer;
+ResourceString
+  SErrAlreadyLoaded = 'MySQL interface already initialized from library %s.';
+  SLoadFailed       = 'Can not load MySQL library "%s". Please check your installation.';
+  
+var 
+  RefCount : integer;
+  LoadedLibrary : String;
+
+Function InitialiseMysql : Integer;
+
+begin
+  // Use Default library
+  Result:=InitialiseMySQL(Mysqllib);
+end;
+
+
+Function InitialiseMysql(Const LibraryName : String) : Integer;
 
-Procedure InitialiseMysql;
 
 begin
-  inc(RefCount);
-  if RefCount = 1 then
+  if (RefCount=0) then
     begin
-    Mysql4LibraryHandle := loadlibrary(Mysqllib);
-    if Mysql4LibraryHandle = nilhandle then
+    MysqlLibraryHandle := loadlibrary(LibraryName);
+    if (MysqlLibraryHandle=nilhandle) then
       begin
-      RefCount := 0;
-      Raise EInOutError.Create('Can not load MySQL client. Is it installed? ('+Mysqllib+')');
+      Raise EInOutError.CreateFmt(SLoadFailed,[LibraryName]);
       end;
+    Inc(RefCount);  
+    LoadedLibrary:=LibraryName;
 // Only the procedure that are given in the c-library documentation are loaded, to
 // avoid problems with 'incomplete' libraries
-    pointer(my_init) := GetProcedureAddress(Mysql4LibraryHandle,'my_init');
-    pointer(my_thread_init) := GetProcedureAddress(Mysql4LibraryHandle,'my_thread_init');
-    pointer(my_thread_end) := GetProcedureAddress(Mysql4LibraryHandle,'my_thread_end');
-
-    pointer(mysql_affected_rows) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_affected_rows');
-    pointer(mysql_autocommit) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_autocommit');
-    pointer(mysql_change_user) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_change_user');
-//    pointer(mysql_charset_name) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_charset_name');
-    pointer(mysql_close) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_close');
-    pointer(mysql_commit) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_commit');
-//    pointer(mysql_connect) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_connect');
-//    pointer(mysql_create_db) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_create_db');
-    pointer(mysql_data_seek) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_data_seek');
-//    pointer(mysql_drop_db) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_drop_db');
-    pointer(mysql_debug) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_debug');
-    pointer(mysql_dump_debug_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_dump_debug_info');
-    pointer(mysql_eof) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_eof');
-    pointer(mysql_errno) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_errno');
-    pointer(mysql_error) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_error');
-    pointer(mysql_escape_string) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_escape_string');
-    pointer(mysql_fetch_field) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_fetch_field');
-    pointer(mysql_fetch_field_direct) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_fetch_field_direct');
-    pointer(mysql_fetch_fields) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_fetch_fields');
-    pointer(mysql_fetch_lengths) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_fetch_lengths');
-    pointer(mysql_fetch_row) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_fetch_row');
-    pointer(mysql_field_seek) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_field_seek');
-    pointer(mysql_field_count) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_field_count');
-    pointer(mysql_field_tell) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_field_tell');
-    pointer(mysql_free_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_free_result');
-    pointer(mysql_get_client_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_client_info');
-    pointer(mysql_get_client_version) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_client_version');
-    pointer(mysql_get_host_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_host_info');
-    pointer(mysql_get_server_version) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_server_version');
-    pointer(mysql_get_proto_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_proto_info');
-    pointer(mysql_get_server_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_server_info');
-    pointer(mysql_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_info');
-    pointer(mysql_init) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_init');
-    pointer(mysql_insert_id) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_insert_id');
-    pointer(mysql_kill) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_kill');
-    pointer(mysql_library_end) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_server_end');
-    pointer(mysql_library_init) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_server_init');
-    pointer(mysql_list_dbs) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_list_dbs');
-    pointer(mysql_list_fields) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_list_fields');
-    pointer(mysql_list_processes) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_list_processes');
-    pointer(mysql_list_tables) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_list_tables');
-    pointer(mysql_more_results) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_more_results');
-    pointer(mysql_next_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_next_result');
-    pointer(mysql_num_fields) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_num_fields');
-    pointer(mysql_num_rows) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_num_rows');
-    pointer(mysql_options) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_options');
-    pointer(mysql_ping) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_ping');
-    pointer(mysql_query) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_query');
-    pointer(mysql_real_connect) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_real_connect');
-    pointer(mysql_real_escape_string) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_real_escape_String');
-    pointer(mysql_real_query) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_real_query');
-    pointer(mysql_refresh) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_refresh');
-//    pointer(mysql_reload) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_reload');
-    pointer(mysql_rollback) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_rollback');
-    pointer(mysql_row_seek) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_row_seek');
-    pointer(mysql_row_tell) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_row_tell');
-    pointer(mysql_select_db) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_select_db');
-    pointer(mysql_server_end) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_server_end');
-    pointer(mysql_server_init) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_server_init');
-    pointer(mysql_set_server_option) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_set_server_option');
-    pointer(mysql_sqlstate) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_sqlstate');
-    pointer(mysql_shutdown) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_shutdown');
-    pointer(mysql_stat) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stat');
-    pointer(mysql_store_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_store_result');
-    pointer(mysql_thread_id) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_thread_id');
-//    pointer(mysql_thread_save) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_thread_save');
-    pointer(mysql_use_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_use_result');
-    pointer(mysql_warning_count) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_warning_count');
-
-    pointer(mysql_stmt_init) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_init');
-    pointer(mysql_stmt_prepare) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_prepare');
-    pointer(mysql_stmt_execute) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_execute');
-    pointer(mysql_stmt_fetch) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_fetch');
-    pointer(mysql_stmt_fetch_column) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_fetch_column');
-    pointer(mysql_stmt_store_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_store_result');
-    pointer(mysql_stmt_param_count) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_param_count');
-    pointer(mysql_stmt_attr_set) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_attr_set');
-    pointer(mysql_stmt_attr_get) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_attr_get');
-    pointer(mysql_stmt_bind_param) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_bind_param');
-    pointer(mysql_stmt_bind_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_bind_result');
-    pointer(mysql_stmt_close) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_close');
-    pointer(mysql_stmt_reset) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_reset');
-    pointer(mysql_stmt_free_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_free_result');
-    pointer(mysql_stmt_send_long_data) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_send_long_data');
-    pointer(mysql_stmt_result_metadata) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_result_metadata');
-    pointer(mysql_stmt_param_metadata) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_param_metadata');
-    pointer(mysql_stmt_errno) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_errno');
-    pointer(mysql_stmt_error) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_error');
-    pointer(mysql_stmt_sqlstate) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_sqlstate');
-    pointer(mysql_stmt_row_seek) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_row_seek');
-    pointer(mysql_stmt_row_tell) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_row_tell');
-    pointer(mysql_stmt_data_seek) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_data_seek');
-    pointer(mysql_stmt_num_rows) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_num_rows');
-    pointer(mysql_stmt_affected_rows) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_affected_rows');
-    pointer(mysql_stmt_insert_id) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_insert_id');
-    pointer(mysql_stmt_field_count) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_field_count');
-    end;
+    pointer(my_init) := GetProcedureAddress(MysqlLibraryHandle,'my_init');
+    pointer(my_thread_init) := GetProcedureAddress(MysqlLibraryHandle,'my_thread_init');
+    pointer(my_thread_end) := GetProcedureAddress(MysqlLibraryHandle,'my_thread_end');
+
+    pointer(mysql_affected_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_affected_rows');
+    pointer(mysql_autocommit) := GetProcedureAddress(MysqlLibraryHandle,'mysql_autocommit');
+    pointer(mysql_change_user) := GetProcedureAddress(MysqlLibraryHandle,'mysql_change_user');
+//    pointer(mysql_charset_name) := GetProcedureAddress(MysqlLibraryHandle,'mysql_charset_name');
+    pointer(mysql_close) := GetProcedureAddress(MysqlLibraryHandle,'mysql_close');
+    pointer(mysql_commit) := GetProcedureAddress(MysqlLibraryHandle,'mysql_commit');
+//    pointer(mysql_connect) := GetProcedureAddress(MysqlLibraryHandle,'mysql_connect');
+//    pointer(mysql_create_db) := GetProcedureAddress(MysqlLibraryHandle,'mysql_create_db');
+    pointer(mysql_data_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_data_seek');
+//    pointer(mysql_drop_db) := GetProcedureAddress(MysqlLibraryHandle,'mysql_drop_db');
+    pointer(mysql_debug) := GetProcedureAddress(MysqlLibraryHandle,'mysql_debug');
+    pointer(mysql_dump_debug_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_dump_debug_info');
+    pointer(mysql_eof) := GetProcedureAddress(MysqlLibraryHandle,'mysql_eof');
+    pointer(mysql_errno) := GetProcedureAddress(MysqlLibraryHandle,'mysql_errno');
+    pointer(mysql_error) := GetProcedureAddress(MysqlLibraryHandle,'mysql_error');
+    pointer(mysql_escape_string) := GetProcedureAddress(MysqlLibraryHandle,'mysql_escape_string');
+    pointer(mysql_fetch_field) := GetProcedureAddress(MysqlLibraryHandle,'mysql_fetch_field');
+    pointer(mysql_fetch_field_direct) := GetProcedureAddress(MysqlLibraryHandle,'mysql_fetch_field_direct');
+    pointer(mysql_fetch_fields) := GetProcedureAddress(MysqlLibraryHandle,'mysql_fetch_fields');
+    pointer(mysql_fetch_lengths) := GetProcedureAddress(MysqlLibraryHandle,'mysql_fetch_lengths');
+    pointer(mysql_fetch_row) := GetProcedureAddress(MysqlLibraryHandle,'mysql_fetch_row');
+    pointer(mysql_field_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_field_seek');
+    pointer(mysql_field_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_field_count');
+    pointer(mysql_field_tell) := GetProcedureAddress(MysqlLibraryHandle,'mysql_field_tell');
+    pointer(mysql_free_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_free_result');
+    pointer(mysql_get_client_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_client_info');
+    pointer(mysql_get_client_version) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_client_version');
+    pointer(mysql_get_host_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_host_info');
+    pointer(mysql_get_server_version) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_server_version');
+    pointer(mysql_get_proto_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_proto_info');
+    pointer(mysql_get_server_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_server_info');
+    pointer(mysql_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_info');
+    pointer(mysql_init) := GetProcedureAddress(MysqlLibraryHandle,'mysql_init');
+    pointer(mysql_insert_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_insert_id');
+    pointer(mysql_kill) := GetProcedureAddress(MysqlLibraryHandle,'mysql_kill');
+    pointer(mysql_library_end) := GetProcedureAddress(MysqlLibraryHandle,'mysql_server_end');
+    pointer(mysql_library_init) := GetProcedureAddress(MysqlLibraryHandle,'mysql_server_init');
+    pointer(mysql_list_dbs) := GetProcedureAddress(MysqlLibraryHandle,'mysql_list_dbs');
+    pointer(mysql_list_fields) := GetProcedureAddress(MysqlLibraryHandle,'mysql_list_fields');
+    pointer(mysql_list_processes) := GetProcedureAddress(MysqlLibraryHandle,'mysql_list_processes');
+    pointer(mysql_list_tables) := GetProcedureAddress(MysqlLibraryHandle,'mysql_list_tables');
+    pointer(mysql_more_results) := GetProcedureAddress(MysqlLibraryHandle,'mysql_more_results');
+    pointer(mysql_next_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_next_result');
+    pointer(mysql_num_fields) := GetProcedureAddress(MysqlLibraryHandle,'mysql_num_fields');
+    pointer(mysql_num_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_num_rows');
+    pointer(mysql_options) := GetProcedureAddress(MysqlLibraryHandle,'mysql_options');
+    pointer(mysql_ping) := GetProcedureAddress(MysqlLibraryHandle,'mysql_ping');
+    pointer(mysql_query) := GetProcedureAddress(MysqlLibraryHandle,'mysql_query');
+    pointer(mysql_real_connect) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_connect');
+    pointer(mysql_real_escape_string) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_escape_String');
+    pointer(mysql_real_query) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_query');
+    pointer(mysql_refresh) := GetProcedureAddress(MysqlLibraryHandle,'mysql_refresh');
+//    pointer(mysql_reload) := GetProcedureAddress(MysqlLibraryHandle,'mysql_reload');
+    pointer(mysql_rollback) := GetProcedureAddress(MysqlLibraryHandle,'mysql_rollback');
+    pointer(mysql_row_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_row_seek');
+    pointer(mysql_row_tell) := GetProcedureAddress(MysqlLibraryHandle,'mysql_row_tell');
+    pointer(mysql_select_db) := GetProcedureAddress(MysqlLibraryHandle,'mysql_select_db');
+    pointer(mysql_server_end) := GetProcedureAddress(MysqlLibraryHandle,'mysql_server_end');
+    pointer(mysql_server_init) := GetProcedureAddress(MysqlLibraryHandle,'mysql_server_init');
+    pointer(mysql_set_server_option) := GetProcedureAddress(MysqlLibraryHandle,'mysql_set_server_option');
+    pointer(mysql_sqlstate) := GetProcedureAddress(MysqlLibraryHandle,'mysql_sqlstate');
+    pointer(mysql_shutdown) := GetProcedureAddress(MysqlLibraryHandle,'mysql_shutdown');
+    pointer(mysql_stat) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stat');
+    pointer(mysql_store_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_store_result');
+    pointer(mysql_thread_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_thread_id');
+//    pointer(mysql_thread_save) := GetProcedureAddress(MysqlLibraryHandle,'mysql_thread_save');
+    pointer(mysql_use_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_use_result');
+    pointer(mysql_warning_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_warning_count');
+    pointer(mysql_stmt_init) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_init');
+    pointer(mysql_stmt_prepare) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_prepare');
+    pointer(mysql_stmt_execute) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_execute');
+    pointer(mysql_stmt_fetch) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_fetch');
+    pointer(mysql_stmt_fetch_column) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_fetch_column');
+    pointer(mysql_stmt_store_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_store_result');
+    pointer(mysql_stmt_param_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_param_count');
+    pointer(mysql_stmt_attr_set) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_attr_set');
+    pointer(mysql_stmt_attr_get) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_attr_get');
+    pointer(mysql_stmt_bind_param) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_bind_param');
+    pointer(mysql_stmt_bind_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_bind_result');
+    pointer(mysql_stmt_close) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_close');
+    pointer(mysql_stmt_reset) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_reset');
+    pointer(mysql_stmt_free_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_free_result');
+    pointer(mysql_stmt_send_long_data) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_send_long_data');
+    pointer(mysql_stmt_result_metadata) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_result_metadata');
+    pointer(mysql_stmt_param_metadata) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_param_metadata');
+    pointer(mysql_stmt_errno) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_errno');
+    pointer(mysql_stmt_error) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_error');
+    pointer(mysql_stmt_sqlstate) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_sqlstate');
+    pointer(mysql_stmt_row_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_row_seek');
+    pointer(mysql_stmt_row_tell) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_row_tell');
+    pointer(mysql_stmt_data_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_data_seek');
+    pointer(mysql_stmt_num_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_num_rows');
+    pointer(mysql_stmt_affected_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_affected_rows');
+    pointer(mysql_stmt_insert_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_insert_id');
+    pointer(mysql_stmt_field_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_field_count');
+    end
+  else
+    If (LibraryName<>LoadedLibrary) then
+      Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+  Result:=RefCount;  
 end;
 
 Procedure ReleaseMysql;
 
 begin
-  if RefCount > 0 then dec(RefCount);
-  if RefCount = 0 then
+  if RefCount> 1 then
+    Dec(RefCount)
+  else if UnloadLibrary(MysqlLibraryHandle) then 
     begin
-    if not UnloadLibrary(Mysql4LibraryHandle) then inc(RefCount);
+    Dec(RefCount);
+    LoadedLibrary:='';
     end;
 end;
 

+ 30 - 8
packages/base/mysql/mysql4dyn.pp

@@ -151,28 +151,43 @@ function IS_BLOB(n : longint) : boolean;
 function MYSQL_COUNT_ERROR : longint;
 function mysql_reload(mysql : pmysql) : longint;
 
-
-Procedure InitialiseMysql4;
+Function InitialiseMysql4 : Integer;
+Function InitialiseMysql4(Const LibraryName : String) : Integer;
 Procedure ReleaseMysql4;
 
 var Mysql4LibraryHandle : TLibHandle;
 
 implementation
 
-var RefCount : integer;
+ResourceString
+  SErrAlreadyLoaded = 'MySQL 4.1 already initialized from library %s';
+  SLoadFailed       = 'Can not load MySQL 4.1 library "%s". Please check your installation.';
+  
+var 
+  RefCount : integer;
+  LoadedLibrary : String;
+  
+Function InitialiseMysql4 : Integer;
+
+begin
+  // Use Default library
+  Result:=InitialiseMySQL4(Mysqllib);
+end;
+
+Function InitialiseMysql4(Const LibraryName : String) : Integer;
 
-Procedure InitialiseMysql4;
 
 begin
   inc(RefCount);
   if RefCount = 1 then
     begin
-    Mysql4LibraryHandle := loadlibrary(Mysqllib);
+    Mysql4LibraryHandle := loadlibrary(LibraryName);
     if Mysql4LibraryHandle = nilhandle then
       begin
       RefCount := 0;
-      Raise EInOutError.Create('Can not load MySQL client. Is it installed? ('+Mysqllib+')');
+      Raise EInOutError.CreateFmt(SLoadFailed,[LibraryName]);
       end;
+    LoadedLibrary:=LibraryName;  
     pointer(mysql_get_client_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_client_info');
 
     // To avoid the strangest problems for ppl using other client-libs
@@ -260,7 +275,11 @@ begin
     pointer(net_safe_read) := GetProcedureAddress(Mysql4LibraryHandle,'net_safe_read');
 
     InitialiseMysql4_com;
-    end;
+    end
+  else
+    If (LibraryName<>LoadedLibrary) then
+      Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+  Result:=RefCount;  
 end;
 
 Procedure ReleaseMysql4;
@@ -269,7 +288,10 @@ begin
   if RefCount > 0 then dec(RefCount);
   if RefCount = 0 then
     begin
-    if not UnloadLibrary(Mysql4LibraryHandle) then inc(RefCount);
+    if not UnloadLibrary(Mysql4LibraryHandle) then 
+      inc(RefCount)
+    else
+      LoadedLibrary:='';
     ReleaseMysql4_com;
     end;
 end;

+ 2 - 1
packages/base/netdb/netdb.pp

@@ -365,7 +365,8 @@ begin
       Inc(I,P+1);
       Inc(O,P);
       end;
-   Until (Payload[I]=#0);    
+   Until (Payload[I]=#0);
+   setlength(result,o-1);
 end;
 
 

+ 13 - 13
packages/base/paszlib/infblock.pas

@@ -118,7 +118,7 @@ begin
     s.check := s.checkfn(cardinal(0), Pbyte(NIL), 0);
     z.adler := s.check;
   end;
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Tracev('inflate:   blocks reset');
   {$ENDIF}
 end;
@@ -158,7 +158,7 @@ begin
   Inc(s^.zend, w);
   s^.checkfn := c;
   s^.mode := ZTYPE;
-  {$IFDEF DEBUG}  
+  {$IFDEF ZLIB_DEBUG}  
   Tracev('inflate:   blocks allocated');
   {$ENDIF}
   inflate_blocks_reset(s^, z, nil);
@@ -240,7 +240,7 @@ begin
         case (t shr 1) of
           0:                         { stored }
             begin
-              {$IFDEF DEBUG}
+              {$IFDEF ZLIB_DEBUG}
               if s.last then
                 Tracev('inflate:     stored block (last)')
               else
@@ -260,7 +260,7 @@ begin
           1:                         { fixed }
             begin
               begin
-                {$IFDEF DEBUG}
+                {$IFDEF ZLIB_DEBUG}
                 if s.last then
                   Tracev('inflate:     fixed codes blocks (last)')
                 else
@@ -290,7 +290,7 @@ begin
             end;
           2:                         { dynamic }
             begin
-              {$IFDEF DEBUG}
+              {$IFDEF ZLIB_DEBUG}
               if s.last then
                 Tracev('inflate:     dynamic codes block (last)')
               else
@@ -367,7 +367,7 @@ begin
         s.sub.left := cardinal(b) and $ffff;
         k := 0;
         b := 0;                      { dump bits }
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracev('inflate:       stored length '+IntToStr(s.sub.left));
         {$ENDIF}
         if s.sub.left <> 0 then
@@ -453,7 +453,7 @@ begin
         dec(s.sub.left, t);
         if (s.sub.left = 0) then
         begin
-          {$IFDEF DEBUG}
+          {$IFDEF ZLIB_DEBUG}
           if (ptrint(q) >= ptrint(s.read)) then
             Tracev('inflate:       stored end '+
                 IntToStr(z.total_out + ptrint(q) - ptrint(s.read)) + ' total out')
@@ -533,7 +533,7 @@ begin
         dec(k, 14);
 
         s.sub.trees.index := 0;
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracev('inflate:       table sizes ok');
         {$ENDIF}
         s.mode := BTREE;
@@ -601,7 +601,7 @@ begin
           exit;
         end;
         s.sub.trees.index := 0;
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracev('inflate:       bits tree ok');
         {$ENDIF}
         s.mode := DTREE;
@@ -756,7 +756,7 @@ begin
             inflate_blocks := inflate_flush(s,z,r);
             exit;
           end;
-          {$IFDEF DEBUG}
+          {$IFDEF ZLIB_DEBUG}
           Tracev('inflate:       trees ok');
           {$ENDIF}          
           { c renamed to cs }
@@ -809,7 +809,7 @@ begin
           m := cardinal(ptrint(s.read)-ptrint(q)-1)
         else
           m := cardinal(ptrint(s.zend)-ptrint(q));
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         if (ptrint(q) >= ptrint(s.read)) then
           Tracev('inflate:       codes end '+
               IntToStr(z.total_out + ptrint(q) - ptrint(s.read)) + ' total out')
@@ -826,7 +826,7 @@ begin
         {$ifndef patch112}
         if (k > 7) then           { return unused byte, if any }
         begin
-          {$IFDEF DEBUG}
+          {$IFDEF ZLIB_DEBUG}
           Assert(k < 16, 'inflate_codes grabbed too many bytes');
           {$ENDIF}
           dec(k, 8);
@@ -920,7 +920,7 @@ begin
   ZFREE(z, s^.window);
   ZFREE(z, s^.hufts);
   ZFREE(z, s);
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Trace('inflate:   blocks freed');
   {$ENDIF}  
   inflate_blocks_free := Z_OK;

+ 7 - 7
packages/base/paszlib/infcodes.pas

@@ -50,7 +50,7 @@ begin
     c^.dbits := Byte(bd);
     c^.ltree := tl;
     c^.dtree := td;
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Tracev('inflate:       codes new');
     {$ENDIF}
   end;
@@ -167,7 +167,7 @@ begin
       if (e = 0) then            { literal }
       begin
         c^.sub.lit := t^.base;
-       {$IFDEF DEBUG}
+       {$IFDEF ZLIB_DEBUG}
         if (t^.base >= $20) and (t^.base < $7f) then
           Tracevv('inflate:         literal '+char(t^.base))
         else
@@ -191,7 +191,7 @@ begin
       end;
       if (e and 32 <> 0) then            { end of block }
       begin
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracevv('inflate:         end of block');
         {$ENDIF}        
         c^.mode := WASH;
@@ -243,7 +243,7 @@ begin
 
       c^.sub.code.need := c^.dbits;
       c^.sub.code.tree := c^.dtree;
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       Tracevv('inflate:         length '+IntToStr(c^.len));
       {$ENDIF}
       c^.mode := DIST;
@@ -337,7 +337,7 @@ begin
       {DUMPBITS(j);}
       b := b shr j;
       dec(k, j);
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       Tracevv('inflate:         distance '+ IntToStr(c^.sub.copy.dist));
       {$ENDIF}
       c^.mode := COPY;
@@ -483,7 +483,7 @@ begin
       {$ifdef patch112}
       if (k > 7) then           { return unused byte, if any }
       begin
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Assert(k < 16, 'inflate_codes grabbed too many bytes');
         {$ENDIF}
         dec(k, 8);
@@ -565,7 +565,7 @@ procedure inflate_codes_free(c : pInflate_codes_state;
                              var z : z_stream);
 begin
   ZFREE(z, c);
-  {$IFDEF DEBUG}  
+  {$IFDEF ZLIB_DEBUG}  
   Tracev('inflate:       codes free');
   {$ENDIF}
 end;

+ 5 - 5
packages/base/paszlib/inffast.pas

@@ -94,7 +94,7 @@ begin
       {DUMPBITS(t^.bits);}
       b := b shr t^.bits;
       dec(k, t^.bits);
-     {$IFDEF DEBUG}
+     {$IFDEF ZLIB_DEBUG}
       if (t^.base >= $20) and (t^.base < $7f) then
         Tracevv('inflate:         * literal '+char(t^.base))
       else
@@ -118,7 +118,7 @@ begin
         {DUMPBITS(e);}
         b := b shr e;
         dec(k, e);
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracevv('inflate:         * length ' + IntToStr(c));
         {$ENDIF}
         { decode distance base of block to copy }
@@ -156,7 +156,7 @@ begin
             b := b shr e;
             dec(k, e);
 
-            {$IFDEF DEBUG}
+            {$IFDEF ZLIB_DEBUG}
             Tracevv('inflate:         * distance '+IntToStr(d));
             {$ENDIF}
             { do the copy }
@@ -236,7 +236,7 @@ begin
           b := b shr t^.bits;
           dec(k, t^.bits);
 
-         {$IFDEF DEBUG}
+         {$IFDEF ZLIB_DEBUG}
           if (t^.base >= $20) and (t^.base < $7f) then
             Tracevv('inflate:         * literal '+char(t^.base))
           else
@@ -251,7 +251,7 @@ begin
       else
         if (e and 32 <> 0) then
         begin
-          {$IFDEF DEBUG}
+          {$IFDEF ZLIB_DEBUG}
           Tracevv('inflate:         * end of block');
           {$ENDIF}
           {UNGRAB}

+ 1 - 1
packages/base/paszlib/inftrees.pas

@@ -30,7 +30,7 @@ const
   MANY = 1440;
 
 
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
 var
   inflate_hufts : cardinal;
 {$endif}

+ 46 - 42
packages/base/paszlib/trees.pas

@@ -42,7 +42,11 @@ interface
 {$I zconf.inc}
 
 uses
-  zbase;
+  {$ifdef ZLIB_DEBUG}
+  sysutils,
+  {$endif}
+  zbase
+  ;
 
 { ===========================================================================
   Internal compression state. }
@@ -283,7 +287,7 @@ type
     matches : cardinal;       { number of string matches in current block }
     last_eob_len : integer;   { bit length of EOB code for last block }
 
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
     bits_sent : longint;    { bit length of the compressed data }
 {$endif}
 
@@ -779,7 +783,7 @@ procedure send_bits(var s : deflate_state;
                     value : integer;   { value to send }
                     length : integer); { number of bits }
 begin
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracevv(' l '+IntToStr(length)+ ' v '+IntToStr(value));
   Assert((length > 0) and (length <= 15), 'invalid length');
   inc(s.bits_sent, longint(length));
@@ -811,7 +815,7 @@ begin
   {$IFDEF NoRangeCheck} {$Q+} {$UNDEF NoRangeCheck} {$ENDIF}
 end;
 
-{$else} { !DEBUG }
+{$else} { !ZLIB_DEBUG }
 
 
 macro send_code(s, c, tree)
@@ -838,7 +842,7 @@ begin integer len := length;\
     s^.bi_valid += len;\
   end\
 end;
-{$endif} { DEBUG }
+{$endif} { ZLIB_DEBUG }
 
 { ===========================================================================
   Reverse the first len bits of a code, using straightforward code (a faster
@@ -896,7 +900,7 @@ begin
   { Check that the bit counts in bl_count are consistent. The last code
     must be all ones. }
 
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Assert (code + bl_count[MAX_BITS]-1 = (1 shl MAX_BITS)-1,
           'inconsistent bit counts');
   Tracev(#13'gen_codes: max_code '+IntToStr(max_code));
@@ -910,7 +914,7 @@ begin
     { Now reverse the bits }
     tree^[n].fc.Code := bi_reverse(next_code[len], len);
     inc(next_code[len]);
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     if (n>31) and (n<128) then
       Tracecv(tree <> tree_ptr(@static_ltree),
        (^M'n #'+IntToStr(n)+' '+char(n)+' l '+IntToStr(len)+' c '+
@@ -1155,7 +1159,7 @@ begin
   s.bi_buf := 0;
   s.bi_valid := 0;
   s.last_eob_len := 8; { enough lookahead for inflate }
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
   s.bits_sent := 0;
 {$endif}
 
@@ -1297,7 +1301,7 @@ begin
   end;
   if (overflow = 0) then
     exit;
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(^M'bit length overflow');
   {$endif}
   { This happens for example on obj2 and pic of the Calgary corpus }
@@ -1332,7 +1336,7 @@ begin
         continue;
       if (tree^[m].dl.Len <> cardinal(bits)) then
       begin
-        {$ifdef DEBUG}
+        {$ifdef ZLIB_DEBUG}
         Trace('code '+IntToStr(m)+' bits '+IntToStr(tree^[m].dl.Len)
               +'.'+IntToStr(bits));
         {$ENDIF}
@@ -1595,7 +1599,7 @@ begin
       if (count < min_count) then
       begin
         repeat
-          {$ifdef DEBUG}
+          {$ifdef ZLIB_DEBUG}
           Tracevvv(#13'cd '+IntToStr(curlen));
           {$ENDIF}
           send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);
@@ -1607,16 +1611,16 @@ begin
         begin
           if (curlen <> prevlen) then
           begin
-            {$ifdef DEBUG}
+            {$ifdef ZLIB_DEBUG}
             Tracevvv(#13'cd '+IntToStr(curlen));
             {$ENDIF}
             send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);
             dec(count);
           end;
-          {$IFDEF DEBUG}
+          {$IFDEF ZLIB_DEBUG}
           Assert((count >= 3) and (count <= 6), ' 3_6?');
           {$ENDIF}
-          {$ifdef DEBUG}
+          {$ifdef ZLIB_DEBUG}
           Tracevvv(#13'cd '+IntToStr(REP_3_6));
           {$ENDIF}
           send_bits(s, s.bl_tree[REP_3_6].fc.Code, s.bl_tree[REP_3_6].dl.Len);
@@ -1625,7 +1629,7 @@ begin
         else
           if (count <= 10) then
           begin
-            {$ifdef DEBUG}
+            {$ifdef ZLIB_DEBUG}
             Tracevvv(#13'cd '+IntToStr(REPZ_3_10));
             {$ENDIF}
             send_bits(s, s.bl_tree[REPZ_3_10].fc.Code, s.bl_tree[REPZ_3_10].dl.Len);
@@ -1633,7 +1637,7 @@ begin
           end
           else
           begin
-            {$ifdef DEBUG}
+            {$ifdef ZLIB_DEBUG}
             Tracevvv(#13'cd '+IntToStr(REPZ_11_138));
             {$ENDIF}
             send_bits(s, s.bl_tree[REPZ_11_138].fc.Code, s.bl_tree[REPZ_11_138].dl.Len);
@@ -1689,7 +1693,7 @@ begin
   end;
   { Update opt_len to include the bit length tree and counts }
   inc(s.opt_len, 3*(max_blindex+1) + 5+5+4);
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(^M'dyn trees: dyn %ld, stat %ld {s.opt_len, s.static_len}');
   {$ENDIF}
 
@@ -1709,7 +1713,7 @@ procedure send_all_trees(var s : deflate_state;
 var
   rank : integer;                    { index in bl_order }
 begin
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Assert ((lcodes >= 257) and (dcodes >= 1) and (blcodes >= 4),
           'not enough codes');
   Assert ((lcodes <= L_CODES) and (dcodes <= D_CODES)
@@ -1721,22 +1725,22 @@ begin
   send_bits(s, blcodes-4,  4); { not -3 as stated in appnote.txt }
   for rank := 0 to blcodes-1 do
   begin
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracev(^M'bl code '+IntToStr(bl_order[rank]));
     {$ENDIF}
     send_bits(s, s.bl_tree[bl_order[rank]].dl.Len, 3);
   end;
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(^M'bl tree: sent '+IntToStr(s.bits_sent));
   {$ENDIF}
 
   send_tree(s, s.dyn_ltree, lcodes-1); { literal tree }
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(^M'lit tree: sent '+IntToStr(s.bits_sent));
   {$ENDIF}
 
   send_tree(s, s.dyn_dtree, dcodes-1); { distance tree }
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(^M'dist tree: sent '+IntToStr(s.bits_sent));
   {$ENDIF}
 end;
@@ -1764,7 +1768,7 @@ begin
     end;
   s.bi_buf := 0;
   s.bi_valid := 0;
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
   s.bits_sent := (s.bits_sent+7) and (not 7);
 {$endif}
 end;
@@ -1795,11 +1799,11 @@ begin
     s.pending_buf^[s.pending] := byte(word(not len) shr 8);;
     inc(s.pending);
 
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
     inc(s.bits_sent, 2*16);
 {$endif}
   end;
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
   inc(s.bits_sent, longint(len shl 3));
 {$endif}
   while (len <> 0) do
@@ -1873,7 +1877,7 @@ end;
 procedure _tr_align(var s : deflate_state);
 begin
   send_bits(s, STATIC_TREES shl 1, 3);
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracevvv(#13'cd '+IntToStr(END_BLOCK));
   {$ENDIF}
   send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);
@@ -1886,7 +1890,7 @@ begin
   if (1 + s.last_eob_len + 10 - s.bi_valid < 9) then
   begin
     send_bits(s, STATIC_TREES shl 1, 3);
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracevvv(#13'cd '+IntToStr(END_BLOCK));
     {$ENDIF}
     send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);
@@ -1957,7 +1961,7 @@ begin
     if (dist = 0) then
     begin
       { send a literal byte }
-      {$ifdef DEBUG}
+      {$ifdef ZLIB_DEBUG}
       Tracevvv(#13'cd '+IntToStr(lc));
       Tracecv((lc > 31) and (lc < 128), ' '+char(lc)+' ');
       {$ENDIF}
@@ -1968,7 +1972,7 @@ begin
       { Here, lc is the match length - MIN_MATCH }
       code := _length_code[lc];
       { send the length code }
-      {$ifdef DEBUG}
+      {$ifdef ZLIB_DEBUG}
       Tracevvv(#13'cd '+IntToStr(code+LITERALS+1));
       {$ENDIF}
       send_bits(s, ltree[code+LITERALS+1].fc.Code, ltree[code+LITERALS+1].dl.Len);
@@ -1985,12 +1989,12 @@ begin
       else
         code := _dist_code[256+(dist shr 7)];
 
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       Assert (code < D_CODES, 'bad d_code');
       {$ENDIF}
 
       { send the distance code }
-      {$ifdef DEBUG}
+      {$ifdef ZLIB_DEBUG}
       Tracevvv(#13'cd '+IntToStr(code));
       {$ENDIF}
       send_bits(s, dtree[code].fc.Code, dtree[code].dl.Len);
@@ -2003,12 +2007,12 @@ begin
     end; { literal or match pair ? }
 
     { Check that the overlay between pending_buf and d_buf+l_buf is ok: }
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert(s.pending < s.lit_bufsize + 2*lx, 'pendingBuf overflow');
     {$ENDIF}
   until (lx >= s.last_lit);
 
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracevvv(#13'cd '+IntToStr(END_BLOCK));
   {$ENDIF}
   send_bits(s, ltree[END_BLOCK].fc.Code, ltree[END_BLOCK].dl.Len);
@@ -2040,12 +2044,12 @@ begin
 
     { Construct the literal and distance trees }
     build_tree(s, s.l_desc);
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracev(^M'lit data: dyn %ld, stat %ld {s.opt_len, s.static_len}');
     {$ENDIF}
 
     build_tree(s, s.d_desc);
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracev(^M'dist data: dyn %ld, stat %ld {s.opt_len, s.static_len}');
     {$ENDIF}
     { At this point, opt_len and static_len are the total bit lengths of
@@ -2059,7 +2063,7 @@ begin
     opt_lenb := (s.opt_len+3+7) shr 3;
     static_lenb := (s.static_len+3+7) shr 3;
 
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracev(^M'opt %lu(%lu) stat %lu(%lu) stored %lu lit %u '+
 	    '{opt_lenb, s.opt_len, static_lenb, s.static_len, stored_len,'+
 	    's.last_lit}');
@@ -2071,7 +2075,7 @@ begin
   end
   else
   begin
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert(buf <> nil, 'lost buf');
     {$ENDIF}
     static_lenb := stored_len + 5;
@@ -2141,7 +2145,7 @@ begin
       compress_block(s, s.dyn_ltree, s.dyn_dtree);
       inc(s.compressed_len, 3 + s.opt_len);
     end;
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Assert (s.compressed_len = s.bits_sent, 'bad compressed size');
   {$ENDIF}
   init_block(s);
@@ -2151,7 +2155,7 @@ begin
     bi_windup(s);
     inc(s.compressed_len, 7);  { align on byte boundary }
   end;
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(#13'comprlen %lu(%lu) {s.compressed_len shr 3,'+
          's.compressed_len-7*ord(eof)}');
   {$ENDIF}
@@ -2168,7 +2172,7 @@ function _tr_tally (var s : deflate_state;
    dist : cardinal;          { distance of matched string }
    lc : cardinal) : boolean; { match length-MIN_MATCH or unmatched char (if dist=0) }
 var
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   MAX_DIST : word;
   {$ENDIF}
   code : word;
@@ -2198,7 +2202,7 @@ begin
       code := _dist_code[dist]
     else
       code := _dist_code[256+(dist shr 7)];
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
 {macro  MAX_DIST(s) <=> ((s)^.w_size-MIN_LOOKAHEAD)
    In order to simplify the code, particularly on 16 bit machines, match
    distances are limited to MAX_DIST instead of WSIZE. }
@@ -2225,7 +2229,7 @@ begin
             (cardinal(5)+extra_dbits[dcode])) );
     end;
     out_length := out_length shr 3;
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracev(^M'last_lit %u, in %ld, out ~%ld(%ld%%) ');
           { s.last_lit, in_length, out_length,
            cardinal(100) - out_length*100 div in_length)); }

+ 2 - 2
packages/base/paszlib/zbase.pas

@@ -399,7 +399,7 @@ const
   PRESET_DICT = $20; { preset dictionary flag in zlib header }
 
 
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   procedure Assert(cond : boolean; msg : string);
   {$ENDIF}
 
@@ -443,7 +443,7 @@ const
 const
   z_verbose : integer = 1;
 
-{$IFDEF DEBUG}
+{$IFDEF ZLIB_DEBUG}
 procedure z_error (m : string);
 {$ENDIF}
 

+ 118 - 126
packages/base/paszlib/zdeflate.pas

@@ -374,7 +374,7 @@ procedure  flush_pending (var strm : z_stream); forward;
 {local}
 function read_buf(strm : z_streamp;
                   buf : Pbyte;
-                  size : cardinal) : integer; forward;
+                  size : cardinal) : cardinal; forward;
 {$ifdef ASMV}
 procedure match_init; { asm code initialization }
 function longest_match(var deflate_state; cur_match : IPos) : cardinal; forward;
@@ -384,7 +384,7 @@ function longest_match(var s : deflate_state; cur_match : IPos) : cardinal;
   forward;
 {$endif}
 
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
 {local}
 procedure check_match(var s : deflate_state;
                       start, match : IPos;
@@ -698,9 +698,7 @@ begin
               and s^.hash_mask;
 
   for n := 0 to length - MIN_MATCH do
-  begin
     INSERT_STRING(s^, n, hash_head);
-  end;
   {if (hash_head <> 0) then
     hash_head := 0;  - to make compiler happy }
   deflateSetDictionary := Z_OK;
@@ -996,7 +994,7 @@ begin
 
     end;
   end;
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Assert(strm.avail_out > 0, 'bug2');
   {$ENDIF}
   if (flush <> Z_FINISH) then
@@ -1139,31 +1137,25 @@ end;
   (See also flush_pending()). }
 
 {local}
-function read_buf(strm : z_streamp; buf : Pbyte; size : cardinal) : integer;
-var
-  len : cardinal;
-begin
-  len := strm^.avail_in;
+function read_buf(strm:z_streamp;buf:Pbyte;size:cardinal):cardinal;
 
-  if (len > size) then
-    len := size;
-  if (len = 0) then
-  begin
-    read_buf := 0;
-    exit;
-  end;
+var len:cardinal;
 
+begin
+  len:=strm^.avail_in;
+  if len>size then
+    len:=size;
   dec(strm^.avail_in, len);
 
-  if deflate_state_ptr(strm^.state)^.noheader = 0 then
-  begin
-    strm^.adler := adler32(strm^.adler, strm^.next_in, len);
-  end;
-  move(strm^.next_in^,buf^,len);
-  inc(strm^.next_in, len);
-  inc(strm^.total_in, len);
-
-  read_buf := len;
+  if len<>0 then
+    begin
+      if deflate_state_ptr(strm^.state)^.noheader=0 then
+        strm^.adler:=adler32(strm^.adler,strm^.next_in,len);
+      move(strm^.next_in^,buf^,len);
+      inc(strm^.next_in,len);
+      inc(strm^.total_in,len);
+    end;
+  read_buf:=len;
 end;
 
 { ===========================================================================
@@ -1279,7 +1271,7 @@ distances are limited to MAX_DIST instead of WSIZE. }
 
     { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
       It is easy to get rid of this optimization if necessary. }
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');
     {$ENDIF}
     { Do not waste too much time if we already have a good match: }
@@ -1293,11 +1285,11 @@ distances are limited to MAX_DIST instead of WSIZE. }
 
     if (cardinal(nice_match) > s.lookahead) then
       nice_match := s.lookahead;
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert(longint(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');
     {$ENDIF}
     repeat
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Assert(cur_match < s.strstart, 'no future');
         {$ENDIF}
         match := @(s.window^[cur_match]);
@@ -1329,7 +1321,7 @@ distances are limited to MAX_DIST instead of WSIZE. }
           at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is
           necessary to put more guard bytes at the end of the window, or
           to check more often for insufficient lookahead. }
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Assert(pzByteArray(scan)^[2] = pzByteArray(match)^[2], 'scan[2]?');
         {$ENDIF}
         inc(scan);
@@ -1344,7 +1336,7 @@ distances are limited to MAX_DIST instead of WSIZE. }
         { The funny "do while" generates better code on most compilers }
 
         { Here, scan <= window+strstart+257 }
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         {$ifopt R+} {$define RangeCheck} {$endif} {$R-}
         Assert(ptrint(scan) <=
                ptrint(@(s.window^[cardinal(s.window_size-1)])),
@@ -1378,7 +1370,7 @@ distances are limited to MAX_DIST instead of WSIZE. }
 
         inc(scan, 2);
         inc(match);
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Assert( scan^ = match^, 'match[2]?');
         {$ENDIF}
         { We check for insufficient lookahead only every 8th comparison;
@@ -1395,7 +1387,7 @@ distances are limited to MAX_DIST instead of WSIZE. }
           inc(scan); inc(match); if (scan^ <> match^) then break;
         until (ptrint(scan) >= ptrint(strend));
 
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Assert(ptrint(scan) <=
                ptrint(@(s.window^[cardinal(s.window_size-1)])),
                'wild scan');
@@ -1454,7 +1446,7 @@ begin
 
     { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
       It is easy to get rid of this optimization if necessary. }
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');
 
     Assert(longint(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');
@@ -1512,7 +1504,7 @@ begin
 end;
 {$endif} { FASTEST }
 
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
 { ===========================================================================
   Check that the match at match_start is indeed a match. }
 
@@ -1639,7 +1631,7 @@ begin
       * Otherwise, window_size == 2*WSIZE so more >= 2.
       * If there was sliding, more >= WSIZE. So in all cases, more >= 2. }
 
-     {$IFDEF DEBUG}
+     {$IFDEF ZLIB_DEBUG}
      Assert(more >= 2, 'more < 2');
      {$ENDIF}
 
@@ -1679,7 +1671,7 @@ begin
 
   s.block_start := s.strstart;
   flush_pending(s.strm^);
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Tracev('[FLUSH]');
   {$ENDIF}
 end;
@@ -1729,7 +1721,7 @@ begin
     { Fill the window as much as possible: }
     if (s.lookahead <= 1) then
     begin
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       Assert( (s.strstart < s.w_size + {MAX_DIST}s.w_size-MIN_LOOKAHEAD) or
               (s.block_start >= longint(s.w_size)), 'slide too late');
       {$ENDIF}
@@ -1743,7 +1735,7 @@ begin
       if (s.lookahead = 0) then
         break; { flush the current block }
     end;
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert(s.block_start >= 0, 'block gone');
     {$ENDIF}
     inc(s.strstart, s.lookahead);
@@ -1754,7 +1746,7 @@ begin
     if (s.strstart = 0) or (longint(s.strstart) >= max_start) then
     begin
       { strstart = 0 is possible when wraparound on 16-bit machine }
-      s.lookahead := cardinal(s.strstart - max_start);
+      s.lookahead := cardinal(s.strstart) - cardinal(max_start);
       s.strstart := cardinal(max_start);
       {FLUSH_BLOCK(s, FALSE);}
       FLUSH_BLOCK_ONLY(s, FALSE);
@@ -1837,9 +1829,7 @@ begin
       dictionary, and set hash_head to the head of the hash chain: }
 
     if (s.lookahead >= MIN_MATCH) then
-    begin
       INSERT_STRING(s, s.strstart, hash_head);
-    end;
 
     { Find the longest match, discarding those <= prev_length.
       At this point we have always match_length < MIN_MATCH }
@@ -1857,7 +1847,7 @@ begin
     end;
     if (s.match_length >= MIN_MATCH) then
     begin
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       check_match(s, s.strstart, s.match_start, s.match_length);
       {$ENDIF}
 
@@ -1908,7 +1898,7 @@ end;
     else
     begin
       { No match, output a literal byte }
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       Tracevv(char(s.window^[s.strstart]));
       {$ENDIF}
       {_tr_tally_lit (s, 0, s.window^[s.strstart], bflush);}
@@ -1960,33 +1950,30 @@ begin
   hash_head := ZNIL;
 
   { Process the input block. }
-  while TRUE do
-  begin
+  repeat
     { Make sure that we always have enough lookahead, except
       at the end of the input file. We need MAX_MATCH bytes
       for the next match, plus MIN_MATCH bytes to insert the
       string following the next match. }
 
     if (s.lookahead < MIN_LOOKAHEAD) then
-    begin
-      fill_window(s);
-      if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then
       begin
-        deflate_slow := need_more;
-        exit;
+        fill_window(s);
+        if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then
+          begin
+            deflate_slow := need_more;
+            exit;
+          end;
+
+        if s.lookahead=0 then
+          break; { flush the current block }
       end;
 
-      if (s.lookahead = 0) then
-        break; { flush the current block }
-    end;
-
     { Insert the string window[strstart .. strstart+2] in the
       dictionary, and set hash_head to the head of the hash chain: }
 
     if (s.lookahead >= MIN_MATCH) then
-    begin
       INSERT_STRING(s, s.strstart, hash_head);
-    end;
 
     { Find the longest match, discarding those <= prev_length. }
 
@@ -1996,113 +1983,118 @@ begin
 
     if (hash_head <> ZNIL) and (s.prev_length < s.max_lazy_match) and
        (s.strstart - hash_head <= {MAX_DIST}(s.w_size-MIN_LOOKAHEAD)) then
-    begin
+      begin
         { To simplify the code, we prevent matches with the string
           of window index 0 (in particular we have to avoid a match
           of the string with itself at the start of the input file). }
 
         if (s.strategy <> Z_HUFFMAN_ONLY) then
-        begin
           s.match_length := longest_match (s, hash_head);
-        end;
         { longest_match() sets match_start }
 
         if (s.match_length <= 5) and ((s.strategy = Z_FILTERED) or
              ((s.match_length = MIN_MATCH) and
               (s.strstart - s.match_start > TOO_FAR))) then
-        begin
+          begin
             { If prev_match is also MIN_MATCH, match_start is garbage
               but we will ignore the current match anyway. }
 
             s.match_length := MIN_MATCH-1;
-        end;
-    end;
+          end;
+      end;
     { If there was a match at the previous step and the current
       match is not better, output the previous match: }
 
-    if (s.prev_length >= MIN_MATCH)
-      and (s.match_length <= s.prev_length) then
-    begin
-      max_insert := s.strstart + s.lookahead - MIN_MATCH;
-      { Do not insert strings in hash table beyond this. }
-      {$ifdef DEBUG}
-      check_match(s, s.strstart-1, s.prev_match, s.prev_length);
-      {$endif}
+    if (s.prev_length>=MIN_MATCH) and (s.match_length<=s.prev_length) then
+      begin
+        max_insert := s.strstart + s.lookahead - MIN_MATCH;
+        { Do not insert strings in hash table beyond this. }
+        {$ifdef ZLIB_DEBUG}
+        check_match(s, s.strstart-1, s.prev_match, s.prev_length);
+        {$endif}
 
-      {_tr_tally_dist(s, s->strstart -1 - s->prev_match,
-	                s->prev_length - MIN_MATCH, bflush);}
-      bflush := _tr_tally(s, s.strstart -1 - s.prev_match,
-                           s.prev_length - MIN_MATCH);
+        {_tr_tally_dist(s, s->strstart -1 - s->prev_match,
+  	                  s->prev_length - MIN_MATCH, bflush);}
+        bflush := _tr_tally(s, s.strstart -1 - s.prev_match,
+                             s.prev_length - MIN_MATCH);
 
       { Insert in hash table all strings up to the end of the match.
         strstart-1 and strstart are already inserted. If there is not
         enough lookahead, the last two strings are not inserted in
         the hash table. }
 
-      dec(s.lookahead, s.prev_length-1);
-      dec(s.prev_length, 2);
-      repeat
+{$ifdef ZLIB_DEBUG}
+        if s.lookahead<s.prev_length-1 then
+           runerror(255);
+{$endif}
+        dec(s.lookahead, s.prev_length-1);
+        dec(s.prev_length, 2);
+        repeat
+          inc(s.strstart);
+          if s.strstart<=max_insert then
+            INSERT_STRING(s, s.strstart, hash_head);
+          dec(s.prev_length);
+        until s.prev_length = 0;
+        s.match_available := false;
+        s.match_length := MIN_MATCH-1;
         inc(s.strstart);
-        if (s.strstart <= max_insert) then
-        begin
-          INSERT_STRING(s, s.strstart, hash_head);
-        end;
-        dec(s.prev_length);
-      until (s.prev_length = 0);
-      s.match_available := FALSE;
-      s.match_length := MIN_MATCH-1;
-      inc(s.strstart);
 
-      if (bflush) then  {FLUSH_BLOCK(s, FALSE);}
-      begin
-        FLUSH_BLOCK_ONLY(s, FALSE);
-        if (s.strm^.avail_out = 0) then
-        begin
-          deflate_slow := need_more;
-          exit;
-        end;
-      end;
-    end
+        if bflush then  {FLUSH_BLOCK(s, FALSE);}
+          begin
+            FLUSH_BLOCK_ONLY(s,false);
+            if s.strm^.avail_out=0 then
+              begin
+                deflate_slow := need_more;
+                exit;
+              end;
+          end;
+      end
     else
-      if (s.match_available) then
-      begin
-        { If there was no match at the previous position, output a
-          single literal. If there was a match but the current match
-          is longer, truncate the previous match to a single literal. }
-        {$IFDEF DEBUG}
-        Tracevv(char(s.window^[s.strstart-1]));
-        {$ENDIF}
-        bflush := _tr_tally (s, 0, s.window^[s.strstart-1]);
-
-        if bflush then
-        begin
-          FLUSH_BLOCK_ONLY(s, FALSE);
-        end;
-        inc(s.strstart);
-        dec(s.lookahead);
-        if (s.strm^.avail_out = 0) then
+      if s.match_available then
         begin
-          deflate_slow := need_more;
-          exit;
-        end;
-      end
+          { If there was no match at the previous position, output a
+            single literal. If there was a match but the current match
+            is longer, truncate the previous match to a single literal. }
+          {$IFDEF ZLIB_DEBUG}
+          Tracevv(char(s.window^[s.strstart-1]));
+          {$ENDIF}
+          bflush := _tr_tally (s, 0, s.window^[s.strstart-1]);
+
+          if bflush then
+            FLUSH_BLOCK_ONLY(s, FALSE);
+          inc(s.strstart);
+{$ifdef ZLIB_DEBUG}
+          if s.lookahead=0 then
+             runerror(255);
+{$endif}
+          dec(s.lookahead);
+          if (s.strm^.avail_out = 0) then
+            begin
+              deflate_slow := need_more;
+              exit;
+            end;
+        end
       else
-      begin
+        begin
         { There is no previous match to compare with, wait for
           the next step to decide. }
 
-        s.match_available := TRUE;
-        inc(s.strstart);
-        dec(s.lookahead);
-      end;
-  end;
+          s.match_available := TRUE;
+          inc(s.strstart);
+{$ifdef ZLIB_DEBUG}
+          if s.lookahead=0 then
+             runerror(255);
+{$endif}
+          dec(s.lookahead);
+        end;
+  until false;
 
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Assert (flush <> Z_NO_FLUSH, 'no flush?');
   {$ENDIF}
   if (s.match_available) then
   begin
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Tracevv(char(s.window^[s.strstart-1]));
     bflush :=
     {$ENDIF}

+ 5 - 5
packages/base/paszlib/zinflate.pas

@@ -219,7 +219,7 @@ begin
   else
     z.state^.mode := METHOD;
   inflate_blocks_reset(z.state^.blocks^, z, Z_NULL);
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Tracev('inflate: reset');
   {$ENDIF}
   inflateReset :=  Z_OK;
@@ -237,7 +237,7 @@ begin
     inflate_blocks_free(z.state^.blocks, z);
   ZFREE(z, z.state);
   z.state := Z_NULL;
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Tracev('inflate: end');
   {$ENDIF}
   inflateEnd :=  Z_OK;
@@ -296,7 +296,7 @@ begin
     inflateInit2_ := Z_MEM_ERROR;
     exit;
   end;
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Tracev('inflate: allocated');
   {$ENDIF}
   { reset state }
@@ -447,7 +447,7 @@ begin
           z.state^.sub.marker := 5;       { can't try inflateSync }
           continue;           { break C-switch }
         end;
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracev('inflate: zlib check ok');
         {$ENDIF}
         z.state^.mode := DONE; { falltrough }
@@ -512,7 +512,7 @@ begin
           z.state^.sub.marker := 5;       { can't try inflateSync }
           continue;      { break C-switch }
         end;
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracev('inflate: zlib header ok');
         {$ENDIF}
         if ((b and PRESET_DICT) = 0) then

+ 4 - 0
packages/extra/gtk2/gtk+/gtk/gtktreeviewcolumn.inc

@@ -182,6 +182,10 @@ procedure gtk_tree_view_column_cell_get_size(tree_column:PGtkTreeViewColumn; cel
             height:Pgint); cdecl; external gtklib;
 function gtk_tree_view_column_cell_is_visible(tree_column:PGtkTreeViewColumn):gboolean; cdecl; external gtklib;
 procedure gtk_tree_view_column_focus_cell(tree_column:PGtkTreeViewColumn; cell:PGtkCellRenderer); cdecl; external gtklib;
+
+// since gtk 2.4
+procedure gtk_tree_view_column_set_expand(tree_column: PGtkTreeViewColumn; Expand : gboolean); cdecl; external gtklib;
+function gtk_tree_view_column_get_expand(tree_column: PGtkTreeViewColumn): gboolean; cdecl; external gtklib;
 {$ENDIF read_interface_rest}
 
 //------------------------------------------------------------------------------